rijen verwijderen op basis van de waarde 1.

[Depant]

Hallo allemaal,

Zou iemand zo vriendelijk willen zijn om mij te helpen met de volgende vraag. Ik zoek een macro die alle rijen verwijdert waar een "1" in staat.
Ik heb een bestand bijgevoegd. Het aantal rijen kan 20 tot 30000 rijen lang zijn. Het is dus ook fijn als het nog een beetje snel zou gaan.

Bijvoorbaat hartelijk dank.

Bekijk bijlage alle rijden verwijderen waaar een 1 in staat.xlsm


Groeten Henk

 

[edmoor]

Zoiets:

Sub VerwijderRegelsMet1()
    Application.ScreenUpdating = False
    For i = Cells(1).CurrentRegion.Rows.Count To 1 Step -1
        If WorksheetFunction.Max(Range("J" & i & ":AY" & i)) = 1 Then
            Rows(i).Delete
        End If
    Next i
    Application.ScreenUpdating = True
End Sub

 

[Depant]

Bedankt voor jullie hulp :thumb: :thumb:

Hallo edmoor.

Hartelijk bedankt voor je hulp.
Ik ben er erg mee geholpen.

Helemaal geweldig!!

:thumb::thumb:

 

[VenA]

Dit gaat in ieder geval niet lekker snel bij 30K rijen. je kan kan beter gebruik maken van het geavanceerde filter.

 

[Depant]

Bedankt voor de tip.

Hallo,

Hartelijk bedankt voor de tip.
Als ik wat meer tijd heb zal ik dat proberen.

Groeten Henk:thumb:

 

[VenA]

Met de uitkomst in een nieuw blad

Sub VenA()
  With Sheet1
    .Range("BA2") = "=COUNTIF(J2:AY2,1)=0"
    .Cells(1).CurrentRegion.Resize(, 51).AdvancedFilter xlFilterCopy, .Range("BA1:BA2"), Sheets.Add.Cells(1)
    .Range("BA2").Clear
  End With
End Sub

 

[Depant]

Foutmelding

Hallo,

Ik ga dan ook echt kijken of ie sneller is, maar ik snap vba niet goed genoeg om de foutmelding te kunnen verhelpen


Sub VenA()
With Sheet1
.Range("BA2") = "=COUNTIF(J2:AY2,1)=0"
.Cells(1).CurrentRegion.Resize(, 51).AdvancedFilter xlFilterCopy, .Range("BA1:BA2"), Sheets.Add.Cells(1)
.Range("BA2").Clear
End With
End Sub

Groeten Depant

 

[VenA]

Maak van sheet1 blad1 of Sheets("SQLHHA20190311185345749818")

 

[Depant]

Foutmelding

Hoi,

Uiteraard het blad waarin je werkt, maar de volgende regel geeft ook een fout...
Ik zou dan toch graag willen dat ie werkte

Sub VenA()
With Blad1
.Range("BA2") = "=COUNTIF(J2:AY2,1)=0"
.Cells(1).CurrentRegion.Resize(, 51).AdvancedFilter xlFilterCopy, .Range("BA1:BA2"), Sheets.Add.Cells(1)
.Range("BA2").Clear
End With
End Sub

 

[edmoor]

Als je zegt een foutmelding te krijgen is het handig deze er ook bij te vermelden.

 

[VenA]

In het voorbeeldbestand werkt het. Wil je voor de leesbaarheid code tussen codetags plaatsen. Als je een foutmelding krijgt dan is het handig om deze te vermelden.

 

[Depant]

Foutmelding

Hoi,

De Runtime-fout '1004':

De veldnaam in het ophaalbereik ontbreekt en of is ongeldig.

Groeten Depant.

 

[Depant]

Hallo Allemaal,

Ik ben er achter. Ik had in het voorbeeld had ik een ruim aantal kolommen genomen. De uitvoer van dit ovezicht had minder kolommen.
Dus gewoon de kolommen er in plakken en lekker ruim laten staan, of de kolommen in macro aanpassen. Hartelijk dank en weer wat geleerd.

:thumb::thumb:


I

 

[VenA]

Ik ga dan ook echt kijken of ie sneller is

En, wat gaat sneller?

 

[Depant]

snelheid.....

Hallo,

Het filter is veel sneller, en heeft achteraf gezien het voordeel dat ze allebei in beeld blijven.
Nog even dit. Jullie hulp bij "https://www.helpmij.nl/forum/showthread.php/941003-inhoud-tabbladen-verbergen" heeft nu bijna 50000 uren geregisteerd van werknmers.
Dat is een groot succes geworden. Over een paar maanden is de "echte" urenregistratie gerealiseerd en zit dat klusje er op. Scheelde ongeveer 3500 uur aan onterecht gedeclareerde uren.

Nogmaals dank.

:thumb::thumb: