Excel: Makro zum Zeilen löschen die bestimmte wörter enthalten

Question

Hallo zusammen,

ich bin ganz neu auf dem Gebiet der Makros und benötige Hilfe!
Ich benötige ein Makro das eine Zeile immer dann löscht wenn ein bestimmtes Wort darin vorkommt. die relevanten Wörter stehen entweder in Spalte B oder E. Also müßten nur diese Spalten geprüft werden. Die Zeile gelöscht werden wenn eines der Wörter irgenwo in diesen beiden spalten vorkommt. Ich bräuchte das Makro so, dass ich gleich die verschiedenen Wörter eingeben kann und das Makro somit nur einmal gestartet werden muß. Das Löschen der Zeile soll erfolgen wenn eines der Wörter vorkommt.
Ich habe noch Excel 2000.
Ich habe ein paar Makros ausprobiert aber die meisten funktionieren einfach nicht.

dieses Makro löscht zwar Zeilen, aber komischerweise nicht alle mit dem Wort, es sind immer noch welche übrig.
Sub such()
Dim suche1 As Range
Dim zaehler1 As Long
Application.ScreenUpdating = False
For zaehler1 = 1 To ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
Set suche1 = ActiveSheet.Range("E" & zaehler1 & ":A" & ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1).Find("Wort1", LookIn:=xlValues)
If Not suche1 Is Nothing Then
zaehler1 = suche1.Row
ActiveSheet.Range(suche1.Row & ":" & suche1.Row).Delete Shift:=xlUp
End If
Next zaehler1
Application.ScreenUpdating = False
MsgBox "Es wurden " & i & " Zeilen gelöscht"
End Sub

die zahl der gelöschten Zeilen wird auch nicht angezeigt.

Kann mir bitte jemand helfen? danke!

Grüße, Joopiter

Answer 1

Hallo Joopiter,

probier's mal so:

Option Explicit

Sub such()
Dim intI As Integer, intL As Integer, strSuch As String
intL = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
Application.ScreenUpdating = False
strSuch = "Wort1" ' Suchwort ersetzen
For intI = intL To 2 Step -1
If Cells(intI, 2).Value = strSuch Then
Rows(intI).Delete
ElseIf Cells(intI, 5).Value = strSuch Then
Rows(intI).Delete
End If
Next
Application.ScreenUpdating = False
End Sub

Feedback wäre nett
Gruss Rainer
_____________________
Windows 7 Ultimate (x64)
Office 2007 Ultimate
Office 2003 Professional

Answer 2

Hi Joopiter,

Sub Loeschen()
Dim lngZeile As Long
Dim lngZaehler As Long
Application.ScreenUpdating = False
For lngZeile = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
If Cells(lngZeile, 1) = "Suchbegriff" Or Cells(lngZeile, 5) = "Suchbegriff" Then
Rows(lngZeile).Delete shift:=xlUp
lngZaehler = lngZaehler + 1
End If
Next lngZeile
Application.ScreenUpdating = True
MsgBox "Es wurden " & lngZaehler & " Zeilen gelöscht"
End Sub

Bis später,
Karin

Answer 3

Hallo Karin, hallo Rainer,

vielen Dank, beide funktionieren, jedoch nur dann wenn der Zellinhalt genau mit dem Suchwort übereinstimmt, geht das auch so, dass wenn nur ein Wort oder der Teil eines Wortes mit dem Suchwort übereinstimmt, die Zeile gelöscht wird? Bei Karins Makro müßte der Suchbegriff 2 mal eingegeben werden, dies läßt sich sicher durch eine Variable lösen, oder? Und dann bräuchte ich das ganze so, dass ich gleich für mehrere Wörter prüfen kann, es dürften so 20-30 sein. Ich muß das ganze häufiger pro Monat durchlaufen lassen.
Vielleicht kann man es so machen, dass ich die Wörter nur in eine Liste zu Beginn schreibe und nicht so viel an den Prgrammzeilen herumfummeln muß ;-)

danke!

Grüße, Joopiter

Answer 4

Hi Joopiter,

bei meinem Code wird geprüft, ob der Suchbegriff in A oder in E vorkommt - wo also muss der Suchbegriff 2 mal eingegeben werden? Du solltest den Code schon erst mal testen.

Wenn der Suchbegriff nur enthalten und nicht identisch sein soll, kannst du Instr verwenden. Wenn es mehrere Suchbegriffe sein sollen, kannst du es vielleicht mit einem Array versuchen.

Bis später,
Karin

Answer 5

Hallo Karin,

danke für Deine Antwort und Hilfe. Natürlich habe ich den code getestet. Das Wort Suchbegriff kommt doch in deinem Code 2x vor, jeweils für Spalte 2 und 5 oder?? Ahhh....ich sehe gerade da steht ne 1 für A ich brauche für B dann setze ich ne 2 ein. Ich verstehe leider gar nix von Makros und weiß darum auch nicht was ein Array ist oder anstatt welchem Begriff ich Instr verwenden kann. Der suchbegriff soll immer für beide Spalten gelten bzw. für die Zeile, also je nach dem was einfacher ist. danke.

Grüße, Joopiter

Answer 6

Hi Joopiter,

Sub Loeschen()
Dim lngZeile As Long
Dim lngZaehler As Long
Dim arrWerte()
Dim bytWerte As Byte
arrWerte = Array("Suchbegriff", "Joopiter")
Application.ScreenUpdating = False
For lngZeile = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
For bytWerte = 0 To UBound(arrWerte())
If InStr(Cells(lngZeile, 2), arrWerte(bytWerte)) > 0 Or _
InStr(Cells(lngZeile, 5), arrWerte(bytWerte)) > 0 Then
Rows(lngZeile).Delete shift:=xlUp
lngZaehler = lngZaehler + 1
End If
Next bytWerte
Next lngZeile
Application.ScreenUpdating = True
MsgBox "Es wurden " & lngZaehler & " Zeilen gelöscht"
End Sub

Die Anzahl der Begriffe, die in Anführungszeichen und durch Komma getrennt im Array stehen, kannst du beliebig (bis auf 255) erweitern.

Bis später,
Karin

Answer 7

Hallo Karin,

herzlichen Dank, habe gerade mal mit 4 Begriffen getestet, funktioniert super, genauso habe ich es mir vorgestellt. mal sehen ob es auch noch geht wenn ich die ganzen begriffe eingegeben habe, dafür brauche ich aber sicher bis morgen. erstmal danke!!

Grüße, Joopiter

Answer 8

Hi Joopiter,

du kannst die Werte auch aus einem Tabellenblatt auslesen und ins Array schreiben, dann müsste der Code so abgeändert werden (die aufgelisteten Werte stehen in Tabelle2, Spalte A):

Sub Loeschen()
Dim lngZeile As Long
Dim lngZaehler As Long
Dim arrWerte()
Dim lngWerte As Long
Dim lngLetzte As Long
With Worksheets("Tabelle2")
lngLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 1)), .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
arrWerte = Application.Transpose(.Range(.Cells(1, 1), .Cells(lngLetzte, 1)))
End With
Application.ScreenUpdating = False
For lngZeile = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
For lngWerte = 1 To UBound(arrWerte())
If InStr(Cells(lngZeile, 2), arrWerte(lngWerte)) > 0 Or _
InStr(Cells(lngZeile, 5), arrWerte(lngWerte)) > 0 Then
Rows(lngZeile).Delete shift:=xlUp
lngZaehler = lngZaehler + 1
End If
Next lngWerte
Next lngZeile
Application.ScreenUpdating = True
MsgBox "Es wurden " & lngZaehler & " Zeilen gelöscht"
End Sub

Bis später,
Karin

Answer 9

hi all :-))

hatte ich per pager eine anfrage

hier eine beliebige mehrfachsuche

suchbegriffanzahl flexibel und durch leerzeichen getrennt

gruss nighty

Option Explicit

Public SpaArr() As String

Sub Beispiel()
Dim Index As Integer
Dim Suche As Range
SumZahlen (InputBox("SUCHEN UND DESSEN ZEILE LOESCHEN", "Bitte geben Sie Ihren Suchbegriff ein !"))
For Index = LBound(SpaArr()) To UBound(SpaArr())
Set Suche = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).Find(SpaArr(Index))
If Not Suche Is Nothing Then
Rows(Suche.Row).Delete Shift:=xlUp
If Index > LBound(SpaArr()) - 1 Then Index = Index - 1
End If
Next Index
End Sub

Function SumZahlen(Zellen As String) As String
Dim ArrZeichen As Integer
Dim Schalter As Boolean
Dim ArrIndex As Integer
ReDim SpaArr(1 To Len([Zellen]))
ArrIndex = 1
For ArrZeichen = 1 To Len([Zellen])
If Mid([Zellen], ArrZeichen, 1) Like "[A-Z,a-z,ÄäÖöÜüß]" = True Then
SpaArr(ArrIndex) = SpaArr(ArrIndex) & Mid([Zellen], ArrZeichen, 1)
Schalter = True
End If
If Schalter = True And Mid([Zellen], ArrZeichen, 1) Like "[A-Z,a-z,ÄäÖöÜüß]" = False Then
ArrIndex = ArrIndex + 1
Schalter = False
End If
Next ArrZeichen
End Function

Answer 10

hi all :-))

noch ein wenig optimiert ^^

gruss nighty

Option Explicit

Public SpaArr() As String

Sub Beispiel()
Dim LetzteZeile As Long
Dim ZeilenIndex As Long
Dim Index As Integer
Dim Suche As Range
StringArray (InputBox("Bitte geben Sie Ihre Suchbegriffe ein,getrent durch ein Leerzeichen !"))
LetzteZeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
ReDim Bereich(1 To Range("A" & Rows.Count).End(xlUp).Row, 1) As Variant
Bereich() = Range("A1:A" & LetzteZeile)
For Index = 1 To UBound(SpaArr())
For ZeilenIndex = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If InStr(1, Bereich(ZeilenIndex, 1), SpaArr(Index), 1) > 1 Or Bereich(ZeilenIndex, 1) = SpaArr(Index) Then
Bereich(ZeilenIndex, 1) = " "
End If
Next ZeilenIndex
Next Index
Range("A1:A" & LetzteZeile) = Bereich()
Range("A1").AutoFilter Field:=1, Criteria1:=" "
Rows("2:" & ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row).Delete Shift:=xlUp
Range("A1").AutoFilter
End Sub

Function StringArray(Zellen As String)
Dim ArrZeichen As Integer
Dim Schalter As Boolean
Dim ArrIndex As Integer
ReDim SpaArr(1 To Len([Zellen]))
ArrIndex = 1
For ArrZeichen = 1 To Len([Zellen])
If Mid([Zellen], ArrZeichen, 1) Like "[A-Z,a-z,ÄäÖöÜüß]" = True Then
SpaArr(ArrIndex) = SpaArr(ArrIndex) & Mid([Zellen], ArrZeichen, 1)
Schalter = True
End If
If Schalter = True And Mid([Zellen], ArrZeichen, 1) Like "[A-Z,a-z,ÄäÖöÜüß]" = False Then
ArrIndex = ArrIndex + 1
Schalter = False
End If
Next ArrZeichen
End Function