• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Lege velden verwijderen macro

Status
Niet open voor verdere reacties.
D

Dappre

Gebruiker
Lid geworden
28 mei 2017
Berichten
102
Beste forumleden,

Middels een macro voeg ik diverse bestanden samen.
Nu krijg ik erg veel lege kolommen en rijen tussen de diverse samenvoeg bestanden. Hoe kan ik deze op een snelle een efficiente manier verwijderen zonder relevante data kwijt te raken?

In het voorbeeld bestand laat ik zien wat ik exact bedoel.
Daarbij zijn de rijen met kruisjes relevant voor mij, waarbij ik het liefst zou zien dat alle inhoud aan elkaar aansluit.
Dus rij D met rij 1.

Alvast bedankt voor een reactie.Bekijk bijlage Voorbeeld.xlsx
 
Code: 
Sub EmptyRow()

Dim LastRow As Long
LastRow = Cells.SpecialCells(xlCellTypeLastCell).Row

Application.ScreenUpdating = False
Set rRange = Range(Range("A1"), Range("A1000").End(xlUp))

For X = LastRow To 1 Step -1
If Range("A" & X).Value = "" Then Range("A" & X).EntireRow.Delete
Next

End Sub

Zodra er in kolom A geen waarde staat, dan verwijderd hij de hele rij. Je moet zelf misschien nog het bereik aanpassen.
 
Of deze, verwijdert de rijen waar geen x in te vinden is:

Code: 
Sub cobbe()
For r = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
 Set d = Rows(r).Find("x")
  If d Is Nothing Then
    Rows(r).Delete
  End If
Next
End Sub
 
Bedankt voor een mooie test.
Helaas vallen beide code tot een vastlopend geheel. De bron is 40mb wat wil zeggen dat er behoorlijk wat rijen uitgespit moeten worden. Dat betekent dat dit helaas geen oplossing bied.
 
Code: 
Sub hsv()
On Error Resume Next
 Columns(1).SpecialCells(4).EntireRow.Delete
End Sub
 
Mijn code ziet er momenteel zo uit:

Code: 
Sub cobbe()
For r = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
 Set d = Rows(r).Find("J")
  If d Is Nothing Then
    Rows(r).Delete
  End If
Next
End Sub

Sub hsv()
On Error Resume Next
 Columns(1).SpecialCells(4).EntireRow.Delete
End Sub

Daarbij wil ik binnen een workbook zoeken op J. Hoe kan ik deze code uitbreiden door bijv. de waarde 'JA' of 'j' toe te passen. Middels een array?
Ik heb overigens het gevoel dat hij na de laatste test meer verwijderd.

Bedankt.
 
Aantonen is beter dan je gevoel.
 
Beste hsv/cobbe:

Mijn code laat zonder de resume toevoeging nog steeds een oneindige zandloper zien. Hoe kan ik de fout achterhalen door te zien waarop hij vast loopt?
 
Wat moet het resultaat worden? Als de relevante data alleen de cellen zijn waar een 'x' staat hoe gaat de inhoud dan aansluiten? Wat staat er in de cellen alleen tekst of is het hele bestand volgestopt met formules en/of voorwaardelijke opmaak?

Code: 
Columns(1).SpecialCells(4).EntireRow.Delete
is razendsnel dus zal je wat meer informatie moeten geven. Al gedacht aan het automatisch berekenen uit te zetten?

Zitten er Change_Events in het bestand?
 
Laatst bewerkt:
Bestand is voorzien van grote hoeveelheid data zonder opmaak of formules. Hij staat vol met codes/getallen en tekst. Wat dat betreft vrij kaal.
 
Met die informatie schiet je niets op.
 
dmv. Usedrange zou het bereik waarbinnen rijen verwijderd moeten worden eventueel al drastisch beperkt worden.
Andere optie is tijdens het samenvoegen van je bestanden al het nodige opruimwerk te verrichten.
Code: 
Usedrange.Columns(1).SpecialCells(4).EntireRow.Delete
 
Drastisch lijkt me een beetje overtrokken Bart.
Ik zie met een timer nl. geen tot weinig verschil.
 
Laatst bewerkt:
ok, schrap het woordje drastisch :eek:
't was een ingeving van de zondagavond
 
Probeer dit eens (om te kijken of dit wel snel genoeg is en het juiste resultaat geeft)

ga naar zoeken en vervangen:
tik in een x
klik op Vind alles
Druk op ctrl a
klik op afsluiten

draai nu meteen dit macrootje(dus niet ergens klikken)

Code: 
Sub probeereens()
    Selection.EntireRow.Copy
    Sheets(2).Paste
End Sub

pas eventueel het sheetnummer aan
 
@HSV

@cow18 beweert dat het bereik drastisch beperkt wordt. Een timer kan dat niet tot uitdrukking brengen en heeft daar dan ook niets mee te maken. Of je leest zijn bijdrage niet goed, of je begrijpt die niet. Maar @cow18 heeft volkomen gelijk.
 
Laatst bewerkt:
Waar heeft @cow18 gelijk @snb ?
Code: 
Sub toemaar()
  MsgBox Columns(1).SpecialCells(4).Address
  MsgBox ActiveSheet.UsedRange.Columns(1).SpecialCells(4).Address
End Sub
 
Code: 
Sub daar()
  MsgBox activesheet.Columns(1).Address & " <> " &  ActiveSheet.UsedRange.Columns(1).Address
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan