aantal keren uitvoeren

Status
Niet open voor verdere reacties.

DirkB

Gebruiker
Lid geworden
24 jun 2014
Berichten
96
Hoi,

in bijgaande lijst heb ik namen, bedragen en soorten (kolomL)
ik wil graag per soort maximaal 10 rijen gebruiken en de rest wissen.

hoe kan ik dat met VBA doen?
 

Bijlagen

  • verwerk calls.xlsm
    20,7 KB · Weergaven: 29
En hoe moet VBA voor je bepalen welke rijen er mogen blijven staan en welke worden verwijderd?
 
dat is niet van belang omdat de regels random zijn gekozen
het gaat me om dat er maximaal 10 per soort overblijven.
van sommige soorten zullen er soms geen tien zijn en een andere keer weer wel
 
Dirk,

Ik heb een halfbakken oplossing voor je, want als je deze code onder een knop zet moet je een paar keer klikken voordat het alle rijen boven de tien heeft verwijderd, maar uiteindelijk kom je er wel.

Waarom ie niet in 1 keer doorjakkert weet ik niet, maar dat zal ik in een vraag op dit forum proberen uit te vinden.

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
 
Dat is mooi Sjon,
het werkt
wel benieuwd naar de code die doorloopt
 
Wellicht heeft iemand anders daar heel snel een antwoord op.:thumb:
 
het is wel bijzonder,
ik heb de code gebruikt in een ander bestand met meer kolommen
bij druk op de knop doet ie het bij 6 van de 7 soorten achter elkaar door
bij de laatste moet ik dan nog 1 x klikken
 
Rijen verwijderen doe je vanaf onderen naar boven.
Code:
Sub hsv()
Dim sn, i As Long
Application.ScreenUpdating = False
sn = Cells(1).CurrentRegion.Resize(, 12)
For i = UBound(sn) To 1 Step -1
 If Application.CountIf(Columns(12), sn(i, 12)) > 10 Then Rows(i).Delete
 Next i
End Sub

Voor een langere code maar snellere methode.
Code:
Sub hsv()
Dim sn, i As Long, c00 As String, c01 As String, c02 As String, teller As Long, st
sn = Cells(1).CurrentRegion.Resize(, 12)
Columns(12).SpecialCells(2).Name = "bereik"
  For i = 1 To UBound(sn)
    If InStr(c00, sn(i, 12)) = 0 Then
      c00 = c00 & sn(i, 12)
      teller = Application.CountIf(Range("bereik"), sn(i, 12))
     If teller < 11 Then
       c01 = Join(Filter(Application.Transpose(Evaluate("if(bereik=""" & sn(i, 12) & """,row(bereik),""~"")")), "~", False), "_") & "_"
     Else
       c01 = Join(Filter(Application.Transpose(Evaluate("if(bereik=""" & sn(i, 12) & """,row(bereik),""~"")")), "~", False), "_") & "_"
       c01 = Mid(c01, 1, InStrRev(Application.Substitute(c01, "_", ";", 10), ";"))
     End If
    c02 = c02 & c01
 End If
 Next i
 Cells(1).CurrentRegion.Resize(, 12).ClearContents
 st = Application.Transpose(Split(c02, "_"))
 Cells(1).Resize(UBound(st) - 1, 12) = Application.Index(sn, st, Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12))
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan