Rijen met bepaalde tekst verwijderen.

[Dokman]

Hallo,

Ik haal en Excel rapport uit en programma bij ons, maar daar staat informatie in die ik niet gebruik.
Deze wil ik graag verwijderen uit het rapport. Ik heb dat gedaan met de code hieronder.

Sub ClearContentsIfContains()

Dim cell, rng As Range
Set rng = Range("I2:I200")

For Each cell In rng
    If cell.Value = "20193850" Then
    cell.EntireRow.ClearContents
    Else
    End If
Next cell

For Each cell In rng
    If cell.Value = "20179250" Then
    cell.EntireRow.ClearContents
    Else
    End If
Next cell

  Dim LastRowIndex As Integer
  Dim RowIndex As Integer
  Dim UsedRng As Range

  Set UsedRng = ActiveSheet.UsedRange
  LastRowIndex = UsedRng.Row - 1 + UsedRng.Rows.Count
  Application.ScreenUpdating = False

  For RowIndex = LastRowIndex To 1 Step -1
    If Application.CountA(Rows(RowIndex)) = 0 Then
      Rows(RowIndex).Delete
    End If
    Next RowIndex

  Application.ScreenUpdating = True
End Sub

De lege rijden die dan ontstaan worden ook gelijk verwijderd.
Nu heb ik 2 vragen.

1. bij

If cell.Value = "20179250" Then

wil ik graag dat hij niet naar het laatste getal kijkt. Want die kan ook en A,B,C enz. zijn.
2. Het gaat om zeker 80 getallen zo als 2017925, moet ik dan telkens die code herhalen of is er en makkelijker manier om een code te maken.

Hier onder en screenshot van hoe het bestand eruitziet.



Alvast bedankt voor jullie interesse.

 

[xbox360]

MSS dit

Hoi,

ik gebruik dit

Sub Methode1()
 
Dim i As Long
With ActiveWorkbook.Sheets(1)
     For i = 10000 To 1 Step -1
        If .Cells(i, "W") Like "*TEST*" Then
            .Cells(i, "W").EntireRow.Delete
        End If

Test kan je alles van maken
W is de kolom

 

[Dokman]

Hoi,

ik gebruik dit

Sub Methode1()
 
Dim i As Long
With ActiveWorkbook.Sheets(1)
     For i = 10000 To 1 Step -1
        If .Cells(i, "W") Like "*TEST*" Then
            .Cells(i, "W").EntireRow.Delete
        End If

Test kan je alles van maken
W is de kolom

Volgens mijn zit er ergens en fout in jouw code. Krijg hem niet werkend. Excel geeft telkens en fout melding.

 

[peter59]

Hallo,

Als ik het goed heb gelezen dan ben je vlgs mij beter af met power query.
Welke versie van excel gebruik je?

 

[Dokman]

ik werk met versie 2013 hoger gaan ze niet op mijn werk.

 

[peter59]

Hallo,

Dat is dan jammer.

Excel 2010 en Excel 2013 voor Windows
Power Query is een gratis invoegtoepassing die u hier kunt downloaden: De Power Query-invoegtoepassing downloaden. hoewel de invoegtoepassing niet meer officieel wordt ondersteund, kunt u deze nog steeds gebruiken. Wanneer deze functie is ingeschakeld, is Power Query beschikbaar via het tabblad Power Query op het lint van Excel.

Dan is mijn aanname dat het werk de invoegtoepassing ook niet ondersteund.

 

[AD1957]

Voor alle duidelijkheid:
Beginnen alle te verwijderen "getallen" met 2019 of 2017 ?

Met een plaatje kunnen we hier niet veel.
Maak eens een voorbeeld van alleen kolom I en met welke 80 "getallen" rekening moet worden gehouden.

 

[snb]

Met 2 maal het gebruik van autofilter ben je klaar.
Zelfs met de hand gaat dit vele malen sneller dan waarmee je nu bezig bent.

Sorteren van het gegevensgebied op de gegevens in kolom I brengt alle gelijksoortige nummers bij elkaar; selecteren en verwijderen een peuleschil.

 

[snb]

With  Range("I1:I200") 
   .autofilter 1, "20193850" 
   .offset(1).specialcells(12).entirerow.delete
   .autofilter
   .autofilter 1, "20179250"
   .offset(1).specialcells(12).entirerow.delete
   .autofilter
end with

 

[xbox360]

@dokman

Sub Methode1()
 
Dim i As Long
With ActiveWorkbook.Sheets(1)
     For i = 10000 To 1 Step -1
        If .Cells(i, "W") Like "*Test*" Then
            .Cells(i, "W").EntireRow.Delete
        End If
Next i
End With
End Sub

en test kan je zelf aanpassen naar je eigen wens

 

[AD1957]

Optie voor meer nummers.
Bij 200 rijen snel genoeg.