VBA zoeken en verwijderen met meer dan 2 criteria

ce123 · 12 jan 2009

Kan iemand mij helpen?

Ik heb een excellijst waarin klantenbestand staat. In kolom B staan een aantal codes. Ik wil een macro schrijven die zoekt naar 6 verschillende codes (in kolom B) en als 1 een van de 6 codes gevonden is, dan dient de gehele regel verwijderd te worden. Met de functie "aangepaste autofilter" kan ik maar 2 criteria tegelijk aangeven. ik kan dus 3 keer deze functie achter elkaar zetten, maar je snapt, dat duurt erg lang.

Kan dit eenvoudiger?

hierbij de codes zoals ik deze nu geschreven heb.

Sub FilterMutatieCode301()
'
' FilterMutatieCode301 Macro
' filteren op mutatie code 301, oude klanten verwijderen
'

'
Sheets("Relaties").Select
Columns("B:B").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="<>301", Criteria2:="<>233", Operator:=xlAnd
Cells.Select
Selection.Copy
Sheets("Blad1").Select
Cells.Select
ActiveSheet.Paste
Sheets("Relaties").Select
Selection.AutoFilter
Selection.ClearContents
Sheets("Blad1").Select
Cells.Select
Selection.Cut
Sheets("Relaties").Select
ActiveSheet.Paste
Range("A1").Select

Sheets("Relaties").Select
Columns("B:B").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="<>404", Criteria2:="<>405", Operator:=xlAnd
Cells.Select
Selection.Copy
Sheets("Blad1").Select
Cells.Select
ActiveSheet.Paste
Sheets("Relaties").Select
Selection.AutoFilter
Selection.ClearContents
Sheets("Blad1").Select
Cells.Select
Selection.Cut
Sheets("Relaties").Select
ActiveSheet.Paste
Range("A1").Select

Sheets("Relaties").Select
Columns("B:B").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="<>403", Criteria2:="<>420", Operator:=xlAnd
Cells.Select
Selection.Copy
Sheets("Blad1").Select
Cells.Select
ActiveSheet.Paste
Sheets("Relaties").Select
Selection.AutoFilter
Selection.ClearContents
Sheets("Blad1").Select
Cells.Select
Selection.Cut
Sheets("Relaties").Select
ActiveSheet.Paste
Range("A1").Select

End Sub

TheLizard · 12 jan 2009

alle kolommen doorlopen, controleren op de waarde en dan regel verwijderen, dus niet gebruik maken van de autofilter...

ik weet zo niet precies de code, maar hier moet het op lijken

for( rij = 0; rij = laatste rij; rij++ )
{
if( kolomB == waarde || kolomB == waarde2 )
row[rij].Delete
}

zoiets?
wel rekening mee houden dat de andere inhoud opschuift en je dus vaker moet controleren, of dan juist de rij niet optelt.

Ginger · 12 jan 2009

CE123, Dit klusje moet je opknappen met het Advanced Filter (uitgebreid filter). Eerst even goed de Excel-help bestuderen en dan aan de slag. Hier kan je namelijk véél meer criteria opgeven en heb je ook geen code nodig.

Groet, Leo

enijhuis · 12 jan 2009

Mocht je het in VBA willen oplossen dan hierbij de code:

Code:

Sub FilterMutatieCode301()

    Const ZOEKKOLOM = 2
    Dim iRow As Integer
    Dim oSheet As Worksheet
    
    Set oSheet = Worksheets("Relaties")
    
    For iRow = oSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
    
        Select Case oSheet.Cells(iRow, ZOEKKOLOM)
            Case 301, 233, 404, 405, 403, 420
                oSheet.Cells(iRow, ZOEKKOLOM).EntireRow.Delete
        End Select
    Next

End Sub

Nb: Negeer de reactie van NBloemendal: dat is c(++)/java/c# en dus onbruikbaar in de VB editor.
Nb2: Als je van onder naar boven regels verwijderd kan de 'opschuifcontrole' achterwege blijven.

ce123 · 13 jan 2009

Allereerst bedankt voor jullie snelle reacties!

@ enijhuis

ik heb deze macro getest en het werkt prima bedankt, echter moet ik wel zeggen dat deze macro langer duurt dan die ik gemaakt heb. (het klantenbestand is nog al groot)

Ik ga me nu nog even verder verdiepen in de oplossing van Leo.

Nogmaals bedankt en als iemand nog een snellere manier weet dan hoor ik het graag.

groeten ce

enijhuis · 13 jan 2009

Hoi ce123

Om de macro een factor 100 te versnellen kun je de schermverversing uitzetten.
Voor de duidelijkheid van het voorbeeld had ik dit achterwege gelaten.

Zie onder de 'versnelde' macro

Code:

Sub FilterMutatieCode301()

    Const ZOEKKOLOM = 2
    Dim iRow As Integer
    Dim oSheet As Worksheet

    On Error GoTo ErrH
    
    Set oSheet = Worksheets("Relaties")
    
    Application.ScreenUpdating = False
    
    For iRow = oSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
    
        Select Case oSheet.Cells(iRow, ZOEKKOLOM)
            Case 301, 233, 404, 405, 403, 420
                oSheet.Cells(iRow, ZOEKKOLOM).EntireRow.Delete
        End Select
    Next
    
CleanUp:
    Application.ScreenUpdating = True
    Exit Sub
ErrH:
    MsgBox Err.Description, vbExclamation
    Resume CleanUp
End Sub

Probeer 'm nou mog maar eens!

snb · 13 jan 2009

Code:

Sub snel()
  Application.ScreenUpdating = False
  With Sheets(1).Columns(2)
    For j = 1 To 3
      .AutoFilter 1, Choose(j, 301, 233, 403), xlOr, Choose(j, 404, 405, 420)
      .SpecialCells(xlCellTypeVisible).Clear
    Next
    .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  End With
  Application.ScreenUpdating = True
End Sub

ce123 · 13 jan 2009

@ Enijhuis

De macro heb ik aangepast. helemaal top! gaat nu razendsnel. Weer wat geleerd. :thumb:

enijhuis · 13 jan 2009

Mooi!:thumb:

Ik ben nu toch wel benieuwd of die van snb nóg sneller gaat

ce123 · 13 jan 2009

@SNB @enijhuis

bedankt voor je code.. deze werkt ook net zo snel. beide ongeveer 5 seconden

ce123 · 9 mrt 2009

Eerste regel wordt automatisch verwijderd

Ik pas op dit moment deze code toe

Sub snel()
Application.ScreenUpdating = False
With Sheets(1).Columns(2)
For j = 1 To 3
.AutoFilter 1, Choose(j, 301, 233, 403), xlOr, Choose(j, 404, 405, 420)
.SpecialCells(xlCellTypeVisible).Clear
Next
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
Application.ScreenUpdating = True
End Sub

De code doet precies wat ik wil, maar net iets te veel. Hij verwijderd standaard de eerste regel / rij. Dit moet niet aangezien de eerst rij voorzien is van Labels. Ik denk dat het fout gaat bij dit stukje code

.SpecialCells(xlCellTypeVisible).Clear

hoe kan ik ervoor zorgen dat de eerste regel met labels niet verwijderd wordt?

Hoop dat iemand me nog een keer kan helpemn. bedankt voor de moeite alvast.

enijhuis · 10 mrt 2009

Hoi ce123,

Je kunt het zo oplossen:

Code:

Sub snel()
    
    Const LABEL = "B1"
    Dim j As Integer
    
    Application.ScreenUpdating = False
    With Sheets(1).Columns(2)
        For j = 1 To 3
        .AutoFilter 1, Choose(j, 301, 233, 403), xlOr, Choose(j, 404, 405, 420)
        .SpecialCells(xlCellTypeVisible).Clear
        Next
        Sheets(1).Range(LABEL) = "Mijn label"
        .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End With
    Application.ScreenUpdating = True
    
End Sub

Hierbij ga ik ervan uit dat het label in cel B1 staat.

Al met al wordt de code er niet overzichtelijker op. Ik raad je daarom aan toch mijn code te gebruiken: die is denk iets onderhoudsvriendelijker (zie 13 januari 2009 10:23). Verdiep je ook eens in het gebruik van breakpoints om door de code heen te stappen zodat je weet wat er gebeurt.

Succes ermee

ce123 · 10 mrt 2009

Hoi Enijhuis,

Bedankt voor je reactie. Ik heb beide formules toegepast. Vorige keer zei ik dat ze alletwee even snel waren. Als ik beide formules nu op mijn excelsheet loslaat blijkt dat de laatst genoemde sneller is. (heeft dit te maken met de grootte van het document? ). Soms loopt hij ook vast. Ook bij jouw formule merk ik dat hij het label (B1) blank maakt en vervolgens delete. Als je een oplossing hiervoor hebt dan heel graag.

Bedoel je met breakpoints dat ik in heb VBA venster op F8 druk om door de stappen heen te gaan? Ik probeer m'n best te doen om zo goed mogelijk te begrijpen wat er gebeurt. Ben zelf net een aantal maanden met VBA bezig (met boeken ernaast en veel oefenen). Helaas ben ik nog niet zo'n expert als jij bent. Als je tips hebt heel graag.

Ik ga je oplossing direct toepassen. Je hoort zo van me of het gelukt is.

Warme bakkertje · 10 mrt 2009

Breakpoints zet je door links van de code in grijze balk te klikken met je muis. Daardoor verschijnt er een bruine lijn door de code. Als je nu de code start loopt deze tot de eerste bruine lijn. Op deze manier kan je hele blokken code doorlopen terwijl met F8 regel per regel uitgevoerd wordt. Zo kan je controleren of je code heeft uitgevoerd wat je hoopt te bereiken. Door van de ene lijn naar de andere te springen kan je zo je hele code doorlopen en ondertussen het resultaat beoordelen.

Mvg

Rudi

snb · 10 mrt 2009

Of

Code:

Sub snel()
  Application.ScreenUpdating = False
  With Sheets(1).Columns(2)
     For j = 1 To 3
      .AutoFilter 1, Choose(j, 301, 233, 403), xlOr, Choose(j, 404, 405, 420)
      .cells(2).resize(.end(xldown).row).SpecialCells(xlCellTypeVisible).Clear
    Next
    .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  End With
  Application.ScreenUpdating = True
End Sub

ce123 · 10 mrt 2009

@enijhuis

Hij werkt perfect! het duurt met deze formule (macro) 2.30 minuut om hem uit tevoeren.
Ik heb net jouw formule toegepast, maar na 20 minuten heb ik excel eruit gegooit (hij loopt vast).

Bedankt allemaal voor de oplossingen en de tips :thumb:

VBA zoeken en verwijderen met meer dan 2 criteria

ce123

Gebruiker

TheLizard

Gebruiker

Ginger

Terugkerende gebruiker

enijhuis

Gebruiker

ce123

Gebruiker

enijhuis

Gebruiker

snb

Verenigingslid

ce123

Gebruiker

enijhuis

Gebruiker

ce123

Gebruiker

ce123

Gebruiker

enijhuis

Gebruiker

ce123

Gebruiker

Warme bakkertje

Meubilair

snb

Verenigingslid

ce123

Gebruiker

Nieuwste berichten

Wij waarderen jouw privacy