Dubbele lege regels verwijderen, sneller script gezocht

[globe]

Ik heb een sheet met soms 10 bladen waar dubbele lege regels moeten worden verwijderd zodat er maar 1 lege rij overblijft.

In bijgaand voorbeeld zou ik dat met onderstaande code doen voor tab Merk 1 en tab Merk 2
Deze lijsten zijn vaak 1000-den regels lang en het script duurt dan erg lang en loopt dikwijls vast.

Is er een optie met een autofilter en wellicht een optie door alle tabbladen tegelijk op te schonen?

In een vorige vraag heb ik geleerd hoe ik dit met sh.cells en sh.sheets kan doen.

code om dubbele regels te verwijderen die ik nu gebruik (per tabblad)

Sub Dubbele_regels_verw()

Sheets("Merk 1").Select
    lr = Range("A" & Rows.Count).End(xlUp).Row
    For i = lr To 9 Step -1
        If Cells(i, 1) = "" And Cells(i - 1, 1) = "" Then
            Cells(i, 1).EntireRow.Delete
        End If
    Next

     
    Sheets("Merk 2").Select
    lr = Range("A" & Rows.Count).End(xlUp).Row
    For i = lr To 9 Step -1
        If Cells(i, 1) = "" And Cells(i - 1, 1) = "" Then
            Cells(i, 1).EntireRow.Delete
        End If
    Next

End Sub

dank alvast!

Guido

 

[edmoor]

Probeer het eens zo:

Sub Dubbele_regels_verw()
    sCalc = Application.Calculation
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    
    With Sheets("Merk 1")
        lr = .Range("A" & Rows.Count).End(xlUp).Row
        For i = lr To 9 Step -1
            If .Cells(i, 1) = "" And .Cells(i - 1, 1) = "" Then
                .Cells(i, 1).EntireRow.Delete
            End If
        Next
    End With

    With Sheets("Merk 2")
        lr = .Range("A" & Rows.Count).End(xlUp).Row
        For i = lr To 9 Step -1
            If .Cells(i, 1) = "" And .Cells(i - 1, 1) = "" Then
                .Cells(i, 1).EntireRow.Delete
            End If
        Next
    End With
     
    Application.Calculation = sCalc
    Application.ScreenUpdating = True
End Sub

 

[globe]

bedankt voor de reactie Edmoor. Ik ga deze maandag testen of het sneller gaat.

De 2 merken waren even als voorbeeld gebruikt, zo doe ik het nu maar dan moet ik dikwijls de macro aanpassen door regels met merken toe te voegen of te wijzigen.
Zou jouw script ook voor alle tabbladen, ongeacht naam en aantal kunnen worden gemaakt?
Zo dat de eerste tabbladen Data_Av en Blad1 met rust gelaten worden maar alles wat er achter staat op geschoond wordt?

 

[edmoor]

Dat kan ook:

Sub Dubbele_regels_verw()
    sCalc = Application.Calculation
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
        
    For Each sh In ThisWorkbook.Sheets
        If sh.Name <> "Data_Av" And sh.Name <> "Blad1" Then
            With sh
                lr = .Range("A" & Rows.Count).End(xlUp).Row
                For i = lr To 9 Step -1
                    If .Cells(i, 1) = "" And .Cells(i - 1, 1) = "" Then .Cells(i, 1).EntireRow.Delete
                Next
            End With
        End If
    Next sh
    
    Application.Calculation = sCalc
    Application.ScreenUpdating = True
End Sub

 

[globe]

wow! lekker snel.

Ik ga hier speciaal op vrijdagavond voor inloggen

Meteen testen op een origineel bestand.

 

[edmoor]

Ik ben benieuwd

 

[globe]

Als ik deze code

For i = lr To 9 Step -1

naar 4 verander ipv 9, kijkt hij dan naar de eerste 4 cellen van de regel?
In kolom E kan af en toe wat staan namelijk waardoor het niet als een lege regel gezien wordt.

verder: CHAPEAU!

 

[edmoor]

Die 9 betekent dat hij kijkt vanaf de laatste regel terug tot regel 9.
Er wordt verder alleen in kolom A gekeken [.Cells(i, 1)]
Die laatste 1 is kolom A.
Een 2 zou kolom B zijn.
3 Is dan C, enz.

 

[globe]

Ik heb de 9 toch in 4 verandert en nu werkt ie vlekkeloos.


nogmaals bedankt!

 

[edmoor]

Graag gedaan en fijne vrijdagavond verder

 

[VenA]

Als het alleen om de lege regels gaat dan is dit wel voldoende

Sub VenA()
  On Error Resume Next 'als er geen lege cellen  in kolom A zijn.
  For Each sh In Sheets
    If InStr("Blad1Data_AV", sh.Name) = 0 Then sh.Columns(1).SpecialCells(4).EntireRow.Delete
  Next sh
End Sub

 

[edmoor]

Die haalt alle lege regels weg en dat was niet de vraag.

 

[VenA]

Staat ook duidelijk in de op Maar wie wil er nu lege regels in een 'tabel'?

 

[edmoor]

De grootste fout die meestal gemaakt wordt bij het maken van een Excel document, is dat men zich eerst met de layout bezig houdt.
Dan loop je vanzelf tegen problemen aan.