For each verwijdert niet in één keer alle rijen

Status
Niet open voor verdere reacties.
SjonR

SjonR

Verenigingslid
Lid geworden
10 nov 2016
Berichten
3.279
Helpers,

Ik loop al een tijdje te emmeren met een for each waarbij ik meerdere keren op een knop moet klikken voordat alle rijen worden verwijderd. Ik weet niet wat ik fout doe waardoor het niet in één keer klikken kan. Jullie waarschijnlijk wel. Bij een oplossing vinden voor een vraagstuk van een andere TS loop ik weer tegen hetzelfde probleem aan.

Waar ga ik de mist in?

Code: 
Private Sub CommandButton1_Click()
Dim Acell As Range
Dim R As Range
Set R = Blad1.Range("L1:L150")
For Each Acell In R
    If Application.WorksheetFunction.CountIf(R, Acell) > 10 Then
    Acell.EntireRow.Delete
    End If
Next Acell
End Sub
 

Bijlagen

  • For each stagneert.xlsm
    21,1 KB · Weergaven: 28
Laatst bewerkt:
Aha Harry, daar was ik na toch een aantal uren speuren op het WWW niet achter gekomen. Ik ga jouw code even proberen te doorgronden.

Bedankt weer!

Gr.

Sjon
 
Of met zonder lus:

Code: 
Sub M_snb()
   [L1:L150] = [if(countif($L1:L150,L1:L150)>10,"",L1:L150)]
   Columns(12).SpecialCells(4).EntireRow.Delete
End Sub
 
Of iets dynamischer

Code: 
Sub VenA()
  With Cells(1, 13)
    .Formula = "=MIN(COUNTIF($L$1:L1,L1),10)"
    .AutoFill Range(.Address, Cells(Rows.Count, 12).End(xlUp).Offset(, 1))
    .Offset(, -1).Resize(Cells(Rows.Count, 12).End(xlUp), 2).RemoveDuplicates Array(1, 2), xlNo
  End With
End Sub
 
@snb,
Zo op het oog leek het me wel een leuke code tot ik het ging testen.
Helaas verwijderd het alle rijen waarvan er meer dan 10 zijn.

@VenA,
Leuk gevonden.
Code: 
.Offset(, -1).Resize(Cells(Rows.Count, 12).End(xlUp)[COLOR=#ff0000].row[/COLOR], 2).RemoveDuplicates Array(1, 2), xlNo


alternatief:
Code: 
Sub hsv()
 Columns(12).SpecialCells(2).Offset(, 1) = "=MIN(COUNTIF($L$1:L1,L1),10)"
 Columns(12).Resize(, 2).RemoveDuplicates Array(1, 2)
 'Columns(1).Resize(, 13).RemoveDuplicates Array(12, 13)
End Sub
 
Laatst bewerkt:
@HSV

Dat was toch ook de bedoeling ?

Vanwege het ontbreken van een vraag moet je die afleiden uit de code. Dan kan deze interpretatie ook:

Code: 
Sub M_snb()
   [L1:L150] = [if(countif(offset($L$1,0,0,row(1:150),1),L1:L150)>10,"",L1:L150)]
   Columns(12).SpecialCells(4).EntireRow.Delete
End Sub
 
Laatst bewerkt:
@snb,

De vraag staat in de link die ik poste, zo is het perfect, :thumb:
 
@HSV,
Dank je.
Bij mij moet het zo zijn anders blijft de laatste regel staan.
Code: 
.Offset(, -1).Resize(Cells(Rows.Count, 12).End(xlUp)[COLOR="#FF0000"].Row + 1[/COLOR], 2).RemoveDuplicates Array(1, 2), xlNo

De AutoFill methode lijkt zo'n 4 x keer sneller dan het geboden alternatief en bijna 6 keer sneller dan de code van @snb
 
@VenA, Ik kom op hele andere resultaten.

De autofill methode is de minst snelle code.
De alternatief is het snelst, gelijk aan die van @snb als je die in een namedrange zet in de code.
 
I.v.m. snelheid:

Code: 
Sub M_snb()
   sn = Columns(12).SpecialCells(2)
   With CreateObject("scripting.dictionary")
     For j = 1 To UBound(sn)
       .Item(sn(j, 1)) = .Item(sn(j, 1)) + 1
       If .Item(sn(j, 1)) > 10 Then sn(j, 1) = ""
     Next
   End With

   With Columns(12).SpecialCells(2).Offset(, 2)
       .Value = sn
       .SpecialCells(4).EntireRow.Delete
    End With
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan