• 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.

macro regels verwijderen

Status
Niet open voor verdere reacties.
Met deze code uit de link moet het lukken.
Code: 
Sub verwijderen()
  For I = Range("A65536").End(xlUp).Row To 1 Step -1
    If Range("A" & I) = 0 Then
      Rows(I).EntireRow.Delete
    End If
  Next
End Sub
Zet de code in een Module en verbind de knop er aan.
Suc6
 

Bijlagen

  • voorbeeld-verwijderen(EA).rar
    12,7 KB · Weergaven: 48
Laatst bewerkt:
@xlhelp,
ik heb geprobeerd te reageren via je site, maar daar kan ik geen bijlagen kwijt, dus daarom doe ik het hier. De conclusies die je daar trekt zijn nogal voortvarend, ze hangen enorm af van de omstandigheden !! In bijlage heb ik alle macros onder elkaar gezet en ze steeds met dezelfde startgegevens geladen. Bovenin staat de parameter AantalRijen en staat nu op 5.000 waardoor er straks om en om een getal en een lege cel komt te staan in de B-kolom van Blad1. Die lege kolommen moeten straks weg.
Laat dan eens de macro "AlleMacros" lopen en laat je verrassen. Vooral je snelle macro gaat ontgoochelen, want de 1e 100 Unions doet hij schitterd, maar vanaf dan gaat het steeds sneller en sneller bergaf. Kijk ook onderin op de statusbalk, daar staat links aan welke rij hij bezig is en rechts hoeveel de laatste 1.000 rijen aan tijd gekost hebben (in sec).
Dit is dus nog maar klein speelgoed, maak van die 5.000 16.200 en schakel je "ditgaatsneluit" want die valt gewoon door de mand ofwel moet je eens je, ik zeg maar wat, 250 areas via Union verzameld hebt een delete doen om mee te kunnen, ik gok maar iets, ik weet niet waar het omslagpunt zit. Dat zijn al andere tijden
Nu gaan we nog een stap verder en zetten AantalRijen op 17.000 en laten het nog een keer lopen. Nu stellen we vast dat je "ditgaatook"-methode eruit knalt op een fout. Excel kan maar iets van een 8.100 en een beetje areas tegelijk aan en dus ga je daar de mist in.
Nu gaan we voor het volle pond, AantalRijen=100.000

Wat is ons besluit nu ?
1. De tijden zoals door jou vermeld, kloppen van geen kanten.
2. Volgens mij bestaat de ideale methode niet als de data zo om en om verdeeld zijn zoals in deze methode, maar eens je bereik >16.200 rijen moet je toch eens vooraf goed testen of je niet voorbij de 8.100 areas gaat.

Probleempje, ik kreeg hem hier niet als xlsm bestand in bijlage, dus sla hem straks op als xlsx voor je begint ermee te werken.
 

Bijlagen

  • xlhelp.xls
    46 KB · Weergaven: 38
Top bedankt voor de hulp:thumb:

Alles wordt goed verwijderd.

Groetjes,

Danielle
 
cow18 zei:
@xlhelp,
Wat is ons besluit nu ?
1. De tijden zoals door jou vermeld, kloppen van geen kanten.
Klik om te vergroten...

Beste cow,

Deze tijden zijn wel degelijk correct bij mijn testgegevens.
Ik heb alle methodes meermaals laten lopen.
Soms weken de tijden heel lichtjes af (= honderste seconden), dus heb ik steeds alles 3x getest en het gemiddelde genomen.

Uiteraard hangt de snelheid van een VBA code ook af van de snelheid van jouw PC, en de brongegevens die je gebruikt waarop de code wordt uitgevoerd. Deze tijden kunnen bij jou dus veel groter of lager zijn dan bij mij.

De tijden die ik vermeld geven gewoon goed aan welk van de methodes het snelste werkt.
 
als ik je reactie lees, dan vermoed ik onvoldoende zelfkritische vermogen. Je hebt je eigen gegevens getest, waar het vermoedelijk nogal meevalt. Hierbij stuur ik je nog even alle macros. Gebruik eens de macro "Vullen" op jouw gegevens en check dan nog een keer de tijden op 100.000 rijen. Dit is de meest extreme manier waarop de gegevens zich ooit zouden kunnen voordoen. Laat me erbij vertellen dat ik hier ook maar proefondervindelijk achter gekomen ben.
groeten
bart
Code: 
Option Explicit
Public t       As Double
Const AantalRijen As Long = 30000

Sub AlleMacros()
  Sheets("Blad2").Activate
  Sheets("blad2").Columns("A:B").Clear
  Vullen
  ditduurtwatlang
  Sheets("blad2").Range("A1:B1") = Array("ditduurtwatlang", Timer - t)
  Vullen
  ditduurtalminderlang
  Sheets("blad2").Range("A2:B2") = Array("ditduurtalminderlang", Timer - t)
  If False Then                                            'vervang straks die true door false om dit deel uit te schakelen
    Vullen
    'ditgaatsnel
    Sheets("blad2").Range("A3:B3") = Array("ditgaatsnel", Timer - t)
  End If
  Vullen
  ditgaatook
  Sheets("blad2").Range("A4:B4") = Array("ditgaatook", Timer - t)
  Vullen
  WissenBS
  Sheets("blad2").Range("A5:B5") = Array("WissenBS", Timer - t)
End Sub

Sub Vullen()
  Dim sh As Worksheet, Bereik As Range, c As Range, i As Long, t As Double
  With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
  End With
  Set sh = Sheets("blad1")
  sh.Cells.Clear
  With sh.Range("B1:B" & AantalRijen)                      'zoveel cellen diep
    .FormulaR1C1 = "=IF(MOD(ROW(),2),ROW(),"""")"          'om en om vullen met een getal en leeg
    .Value = .Value
  End With
End Sub

Sub ditduurtwatlang()
  Dim i As Long, t2 As Double
  With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
  End With
  t = Timer
  With ActiveWorkbook.Sheets("blad1")
    For i = AantalRijen To 1 Step -1
      'If i Mod 1000 = 0 Then Application.StatusBar = CStr(i) & Space(10) & Timer - t2: t2 = Timer
      If .Cells(i, "b") = "" Then
        .Cells(i, "b").EntireRow.Delete
      End If
    Next i
  End With
End Sub

Sub ditduurtalminderlang()
  Dim i As Long, t2 As Double
  t = Timer
  With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
  End With
  With ActiveWorkbook.Sheets("blad1")
    For i = AantalRijen To 1 Step -1
      'If i Mod 1000 = 0 Then Application.StatusBar = CStr(i) & Space(10) & Timer - t2: t2 = Timer
      If .Cells(i, "b") = "" Then
        .Cells(i, "b").EntireRow.Delete
      End If
    Next i
  End With
  With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
  End With
End Sub

Sub ditgaatsnel()
  Dim i As Long, rng As Range, t2 As Double
  t = Timer
  With ActiveWorkbook.Sheets("blad1")
    For i = 1 To AantalRijen
      'If i Mod 1000 = 0 Then Application.StatusBar = CStr(i) & Space(10) & Timer - t2: t2 = Timer
      With .Cells(i, "b")
        If .Value = "" Then
          If rng Is Nothing Then
            Set rng = .Cells
          Else
            Set rng = Application.Union(rng, .Cells)
          End If
        End If
      End With
    Next i
    If Not rng Is Nothing Then rng.EntireRow.Delete
  End With
End Sub

Sub ditgaatook()
  t = Timer
  On Error Resume Next
  Sheets("blad1").Range("B:B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  On Error GoTo 0
End Sub

Sub WissenBS()
  Dim sh As Worksheet, Bereik As Range, c As Range, i As Long, c1 As Range, t2 As Double
  t = Timer: t2 = Timer
  With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
  End With
  Set sh = Sheets("blad1")
  sh.AutoFilterMode = False
  Set Bereik = Intersect(sh.Columns("B"), sh.UsedRange)
  '.AutoFilter 1, ""
  On Error Resume Next
  Set c = Bereik.Range("A1")
  Do
    'Application.StatusBar = CStr(c.Row) & Space(10) & Timer - t2
    t2 = Timer
    Set c1 = c
    Set c = sh.Cells(WorksheetFunction.Min(c.Offset(16200).Row, Bereik.Rows.Count + Bereik.Row), "B")
    Application.StatusBar = CStr(c.Row)
    'MsgBox c1.Row & vbTab & c.Row & vbTab & c1.Resize(c.Row - c1.Row).Address
    c1.Resize(c.Row - c1.Row).SpecialCells(xlBlanks).EntireRow.Delete
  Loop While c.Row <= Bereik.Row + Bereik.Rows.Count - 1
  sh.AutoFilterMode = False
  With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
  End With
  'MsgBox Timer - t
End Sub
 
Beste Bart,

Bedankt nog voor de opmerking ivm de areas, dit was ik vergeten te vermelden in mijn artikel.

Uit enkele extra tests (ik had vooral getest op veel rijen aanwezig en enkele rijen schrappen, terwijl het blijkbaar vooral draait om het aantal rijen dat geschrapt moet worden) blijkt dat het inderdaad moeilijk te bepalen is welke methode het snelste werkt in welke situatie.

Ik ga mijn artikel herzien met extra testresultaten. Je mag zeker een vermelding voor je bijdrage verwachten!
 
Laatst bewerkt:
cow18 zei:
als ik je reactie lees, dan vermoed ik onvoldoende zelfkritische vermogen. Je hebt je eigen gegevens getest, waar het vermoedelijk nogal meevalt. Hierbij stuur ik je nog even alle macros. Gebruik eens de macro "Vullen" op jouw gegevens en check dan nog een keer de tijden op 100.000 rijen. Dit is de meest extreme manier waarop de gegevens zich ooit zouden kunnen voordoen. Laat me erbij vertellen dat ik hier ook maar proefondervindelijk achter gekomen ben.
groeten
bart
Code: 
Option Explicit
Public t       As Double
Const AantalRijen As Long = 30000

Sub AlleMacros()
  Sheets("Blad2").Activate
  Sheets("blad2").Columns("A:B").Clear
  Vullen
  ditduurtwatlang
  Sheets("blad2").Range("A1:B1") = Array("ditduurtwatlang", Timer - t)
  Vullen
  ditduurtalminderlang
  Sheets("blad2").Range("A2:B2") = Array("ditduurtalminderlang", Timer - t)
  If False Then                                            'vervang straks die true door false om dit deel uit te schakelen
    Vullen
    'ditgaatsnel
    Sheets("blad2").Range("A3:B3") = Array("ditgaatsnel", Timer - t)
  End If
  Vullen
  ditgaatook
  Sheets("blad2").Range("A4:B4") = Array("ditgaatook", Timer - t)
  Vullen
  WissenBS
  Sheets("blad2").Range("A5:B5") = Array("WissenBS", Timer - t)
End Sub

Sub Vullen()
  Dim sh As Worksheet, Bereik As Range, c As Range, i As Long, t As Double
  With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
  End With
  Set sh = Sheets("blad1")
  sh.Cells.Clear
  With sh.Range("B1:B" & AantalRijen)                      'zoveel cellen diep
    .FormulaR1C1 = "=IF(MOD(ROW(),2),ROW(),"""")"          'om en om vullen met een getal en leeg
    .Value = .Value
  End With
End Sub

Sub ditduurtwatlang()
  Dim i As Long, t2 As Double
  With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
  End With
  t = Timer
  With ActiveWorkbook.Sheets("blad1")
    For i = AantalRijen To 1 Step -1
      'If i Mod 1000 = 0 Then Application.StatusBar = CStr(i) & Space(10) & Timer - t2: t2 = Timer
      If .Cells(i, "b") = "" Then
        .Cells(i, "b").EntireRow.Delete
      End If
    Next i
  End With
End Sub

Sub ditduurtalminderlang()
  Dim i As Long, t2 As Double
  t = Timer
  With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
  End With
  With ActiveWorkbook.Sheets("blad1")
    For i = AantalRijen To 1 Step -1
      'If i Mod 1000 = 0 Then Application.StatusBar = CStr(i) & Space(10) & Timer - t2: t2 = Timer
      If .Cells(i, "b") = "" Then
        .Cells(i, "b").EntireRow.Delete
      End If
    Next i
  End With
  With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
  End With
End Sub

Sub ditgaatsnel()
  Dim i As Long, rng As Range, t2 As Double
  t = Timer
  With ActiveWorkbook.Sheets("blad1")
    For i = 1 To AantalRijen
      'If i Mod 1000 = 0 Then Application.StatusBar = CStr(i) & Space(10) & Timer - t2: t2 = Timer
      With .Cells(i, "b")
        If .Value = "" Then
          If rng Is Nothing Then
            Set rng = .Cells
          Else
            Set rng = Application.Union(rng, .Cells)
          End If
        End If
      End With
    Next i
    If Not rng Is Nothing Then rng.EntireRow.Delete
  End With
End Sub

Sub ditgaatook()
  t = Timer
  On Error Resume Next
  Sheets("blad1").Range("B:B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  On Error GoTo 0
End Sub

Sub WissenBS()
  Dim sh As Worksheet, Bereik As Range, c As Range, i As Long, c1 As Range, t2 As Double
  t = Timer: t2 = Timer
  With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
  End With
  Set sh = Sheets("blad1")
  sh.AutoFilterMode = False
  Set Bereik = Intersect(sh.Columns("B"), sh.UsedRange)
  '.AutoFilter 1, ""
  On Error Resume Next
  Set c = Bereik.Range("A1")
  Do
    'Application.StatusBar = CStr(c.Row) & Space(10) & Timer - t2
    t2 = Timer
    Set c1 = c
    Set c = sh.Cells(WorksheetFunction.Min(c.Offset(16200).Row, Bereik.Rows.Count + Bereik.Row), "B")
    Application.StatusBar = CStr(c.Row)
    'MsgBox c1.Row & vbTab & c.Row & vbTab & c1.Resize(c.Row - c1.Row).Address
    c1.Resize(c.Row - c1.Row).SpecialCells(xlBlanks).EntireRow.Delete
  Loop While c.Row <= Bereik.Row + Bereik.Rows.Count - 1
  sh.AutoFilterMode = False
  With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
  End With
  'MsgBox Timer - t
End Sub
Klik om te vergroten...

Hier nog het resultaat als ik jouw macro laat lopen:
 

Bijlagen

  • ScreenShot116.png
    ScreenShot116.png
    6,9 KB · Weergaven: 57
hierbij heb ik je mijn emailadres gestuurd, je kan dus hierboven terug dat emailadres verwijderen om spam te vermijden.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan