ich bin verzweifelt auf der Suche nach einem Add-in, Makro oder sonst irgendwas wie mein Problem gelöst werden kann. Über die Suche habe ich noch nichts vergleichbares gefunden.
So aber nun zu meinem eigentlichen Problem (Aufgabe):
Ich habe eine Excel Tabelle mit ca. 3.000 - 15.000 Adress-Datensätzen.
Die Tabelle hat 5 Spalten A-E:
Firmenname PLZ Ort Branchenschlüssel eMail/Internet
Jetzt würde ich gerne die Tabelle nach verschiedenen Begriffen (ca. 20 Stk.)durchsuchen lassen und sobald einer der Begriffe in einer Zeile vorkommt, soll diese Zeile gelöscht werden.
z.B. möchte ich das aus der Adressliste automatisch alle Zeilen (Adressen) gelöscht werden in den der Begriff, Stadtverwaltung, Kommunen, Vereine, Stiftung oder ähnliches steht.
Da unsere Sekretärin derzeit jede Zeile für Zeile durchgehen muss, sitzt diese stellenweise Tage lang an den Listen, jeoch sollte es doch die Möglichkeit bei Excel geben dies einfacher und automatisch zu machen.
So aber nun zu meinem eigentlichen Problem (Aufgabe):
Ich habe eine Excel Tabelle mit ca. 3.000 - 15.000
Adress-Datensätzen.
Die Tabelle hat 5 Spalten A-E:
Firmenname PLZ Ort Branchenschlüssel eMail/Internet
Gut, ich gehe mal davon aus, dass Du eine Tabelle „Adressen“ hast, in der die Adressen stehen. Dann brauchst Du eine Tabelle „Killwords“, in der Du in die Spalte A direkt untereinander alle Worte schreibst, die Du rausfiltern willst.
Dann sollte folgendes Makro ungefähr das tun, was Du brauchst:
Sub ZeilenLoeschen()
Dim lngZeileKillwords As Long
Dim lngZeileAdressen As Long
Dim lngSpalteAdressen As Long
Dim bLoeschen As Boolean
lngZeileAdressen = 2 ' wenn in erster Zeile Spaltenüberschriften stehen
' so lange, bis man zu einer Leerzeile kommt
Do While (Worksheets("Adressen").Cells(lngZeileAdressen, 1) "") And (lngZeileAdressen "") \_
And (lngZeileKillwords 0)
lngZeileKillwords = lngZeileKillwords + 1
Loop
' nächste Spalte
lngSpalteAdressen = lngSpalteAdressen + 1
Loop Until bLoeschen Or lngSpalteAdressen \> 5
' Zeile löschen?
If bLoeschen Then
Worksheets("Adressen").Rows(lngZeileAdressen).Delete
' weil gleich die nächste Zeile genommen wird:
lngZeileAdressen = lngZeileAdressen - 1
End If
' nächste Adresse
lngZeileAdressen = lngZeileAdressen + 1
Loop
End Sub
Das tut erst mal, ist aber vielleicht nicht das schnellste. Hier könntest Du vielleicht noch mit WorksheetFunctions was gewinnen. Aber wie heißt es so schön: Make it work before you make it fast.
Kann ich das Makro irgendwie so abspeichern das es als Knopf
oben irgendwo dann im Excel auftaucht?
Blende Dir die Symbolleiste „Formular“ ein, klicke auf die Befehlsschaltfläche, ziehe Dir diese dorthin, wo Du sie haben willst, und wähle dann das Makro aus. Anschließend Datei wieder speichern, und das wärs…
Hi,
hier eine Lösung, wenn die 20 Begriffe fest sind.
‚lag‘ bei mir rum.
Sub RowDelete
Dim i
Dim intAnz
Dim j
Dim arStr2Del(19) As String
'hier die 20 Begriffe eingeben wenn es weniger sind oben verändern, wenn es mehr sind dementsprechend erhöhen.
' achtung die NULL zählt mit, wenn es also 20 Begriffe sind von 0..19
'wenn es 24 Begriffe sind von 0..23
arStr2Del(0) = "Stadtverwaltung"
arStr2Del(1) = "...
For i = 0 To UBound(arStr2Del)
intAnz = Application.WorksheetFunction.CountIf(Cells, "\*" & arStr2Del(i) & "\*")
For j = 1 To intAnz
wksLokal.Cells.Find(What:=arStr2Del(i) & "\*").EntireRow.Delete
Next j
Next i
End Sub
Vom gefühl her würde ich sagen, dass die Lösung schneller ist.
Ist aber unkomfortabler , da die 20 Begriffe hier eingeben werden müssen und nicht in einem Worksheet.
Falls Du einen Vergleich laufen läßt wäre eine Rückmeldung, was schneller ist interessant.
Grüße
Winter
P.S.
Ich denke die Original-Lösung ist von Reinhard, aber auf alle Fälle von hier. Habe Sie angepasst das es passt.
So nach einigen Tests muss ich sagen das Makro ist perfekt und funktioniert einwandfrei, bis auf eine kleinigkeit bei manchen Excel Listen bricht er er mit folgender Fehlermeldung ab:
Typen unverträglichkeit
warum dies so ist habe ich auch schon herausgefunden, bei manchen Listen ist zwischen vielen vielen Zeilen, 2-3 Zeilen bei denen in irgendeinem Feld #Name? steht.
Was darauf hindeutet es ist eine „Formel“ ist, denn wenn ich drauf klicke ssteht als Wert =firmenname drin
Gibts eine Möglichkeit diese zu „überspringen“ oder zu ignorieren, ansonsten habe ich es so gemacht das ich mir die spalten sortieren lassen und löschen die dann vorm suchen kurz raus.
Gruß und danke Benny
[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]
hier eine Lösung, wenn die 20 Begriffe fest sind.
‚lag‘ bei mir rum.
Sub RowDelete
Dim i
Dim intAnz
Dim j
Dim arStr2Del(19) As String
'hier die 20 Begriffe eingeben wenn es weniger sind oben
Hier kann man auch einfach die Tabelle, die ich verwendet habe auslesen. Vorher ein Dim arStr2Del(), dann die Einträge, die in der Tabelle stehen, zählen, dann ein Redim auf arStr2Del, dann die Einträge einlesen und weiter geht’s!
Ich würde deutlichst vermuten, dass dieses Ding viiiieeeel schneller ist…
Ist aber unkomfortabler , da die 20 Begriffe
hier eingeben werden müssen und nicht in einem Worksheet.
Hallo Winter,
dann lese die Begriffe doch ein aus einer tabelle, z.B. so:
Sub tt()
Dim arStr2Del, i
With Worksheets("Tabelle2")
Set arStr2Del = .Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
For i = 1 To arStr2Del.Cells.Count
'
'weiterer Code
'
Next i
End With
End Sub
So nach einigen Tests muss ich sagen das Makro ist perfekt und
funktioniert einwandfrei, bis auf eine kleinigkeit bei manchen
Excel Listen bricht er er mit folgender Fehlermeldung ab:
Typen unverträglichkeit
warum dies so ist habe ich auch schon herausgefunden, bei
manchen Listen ist zwischen vielen vielen Zeilen, 2-3 Zeilen
bei denen in irgendeinem Feld #Name? steht.
Was darauf hindeutet es ist eine „Formel“ ist, denn wenn ich
drauf klicke ssteht als Wert =firmenname drin
Gibts eine Möglichkeit diese zu „überspringen“ oder zu
ignorieren, ansonsten habe ich es so gemacht das ich mir die
spalten sortieren lassen und löschen die dann vorm suchen kurz
raus.
Klar:
Sub ZeilenLoeschen()
Const cstrProcName = "ZeilenLoeschen" 'ErrorHandler:blush:$N=FindFiles
Dim lngZeileKillwords As Long
Dim lngZeileAdressen As Long
Dim lngSpalteAdressen As Long
Dim bLoeschen As Boolean
'--------------------
On Error GoTo ErrorHandler
lngZeileAdressen = 2 ' wenn in erster Zeile Spaltenüberschriften stehen
' so lange, bis man zu einer Leerzeile kommt
Do While (Worksheets("Adressen").Cells(lngZeileAdressen, 1) "") And (lngZeileAdressen "") \_
And (lngZeileKillwords 0)
lngZeileKillwords = lngZeileKillwords + 1
Loop
' nächste Spalte
lngSpalteAdressen = lngSpalteAdressen + 1
Loop Until bLoeschen Or lngSpalteAdressen \> 5
' Zeile löschen?
If bLoeschen Then
Worksheets("Adressen").Rows(lngZeileAdressen).Delete
' weil gleich die nächste Zeile genommen wird:
lngZeileAdressen = lngZeileAdressen - 1
End If
' nächste Adresse
lngZeileAdressen = lngZeileAdressen + 1
Loop
' Fehlerbehandlungsblock hinzugefügt vom Fehlerbehandlungsroutinen-Add-In. Bearbeiten Sie diesen Codeabschnitt NICHT.
'--------------------
ErrorHandler:
Select Case Err.Number
Case 0
Case 13
bLoeschen = True ' wenn auch eine Zeile mit solchen Fehlern gelöscht werden soll
Resume Next
Case Else
MsgBox "Fehler: " & vbTab & Err.Number & "-" & Err.Description & vbCrLf \_
& "Modul:" & vbTab & "Modul1" & vbCrLf \_
& "Funktion:" & vbTab & cstrProcName, vbExclamation + vbOKOnly, "Fehler!"
Resume ErrorHandler
End Select
' Ende des Fehlerbehandlungsblocks.
End Sub
Je nach dem, ob die Zeile gelöscht oder stehen gelassen (bzw. abhängig von den anderen Zellen gelöscht) werden soll: das bLoeschen = True in der Fehlerbehandlung ggf. rauswerfen.
Hallo Winter,
dann lese die Begriffe doch ein aus einer tabelle, z.B. so:
Sub tt()
Dim arStr2Del, i
With Worksheets(„Tabelle2“)
Set arStr2Del = .Range(„A1:A“ & .Cells(Rows.Count,
1).End(xlUp).Row)
End Sub
Hallo Reinhard,
ich wußte das das geht, meine Lösung wäre allerdings nicht so elegant wir Deine gesesen. Aber so hat er das beste aus zwei Welten.
Grüße Winter
Jetzt würde ich gerne die Tabelle nach verschiedenen Begriffen
(ca. 20 Stk.)durchsuchen lassen und sobald einer der Begriffe
in einer Zeile vorkommt, soll diese Zeile gelöscht werden.
z.B. möchte ich das aus der Adressliste automatisch alle
Zeilen (Adressen) gelöscht werden in den der Begriff,
Stadtverwaltung, Kommunen, Vereine, Stiftung oder ähnliches
steht.
Hi Bungee,
ist unklar geblieben ob die verbotenen Wörter nur in einer Spalte vorkommen können oder in mehreren, desgleichen für die Fehlermeldung von Formeln.
Der Code geht mal von allen 5 Splaten aus.
Option Explicit
'
Sub RowDelete()
Dim Zei1 As Long, wks1 As Worksheet, wks2 As Worksheet, Loesch As Boolean
Dim Spa1 As Long
Set wks1 = Worksheets("Tabelle1") ' Datenliste
Set wks2 = Worksheets("Tabelle2") ' Verbotswörterliste
With wks1
For Zei1 = .Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
For Spa1 = 1 To 5
If Application.WorksheetFunction.CountIf(wks2.Columns(1), .Cells(Zei1, Spa1)) \> 0 Then
Loesch = True
Exit For
ElseIf IsError(.Cells(Zei1, 1)) Then
Loesch = True
Exit For
End If
Next Spa1
If Loesch = True Then .Cells(Zei1, 1).EntireRow.Delete
Loesch = False
Next Zei1
End With
End Sub
auch der Error Handler klappt wunderbar, ich danke euch rechtherzlich für die spitzen Hilfe. Also bei einer Liste mit ~15.000 Adressen benötigt das Makro von Manfred ca. 3 Minuten, was absolut super und in Ordnung ist. Wenns mir die Zeit heute zu lässt werde ich das andere Makro noch testen wie lange das in etwa braucht.
[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]