Daten bereinigen

Guten Abend,
Ich arbeite seit einiger Zeit mit Daten von Klicktel die ich mir von der CD runterlade und die Daten entpacke und in meine Arbeitsmappe unter "Grunddaten" ablege.
Nun ist es so, dass ich nicht alle Daten benötige, ist es möglich, das bei bestimmten Wörter zum Beispiel "kath.", "Elektro", ";Feuerwehr", "Sanitär" oder "Gemeinde", und und und ( egal als Einzelwort oder als Teil eines Wortes geschrieben ) die gesamte Zeile automatisch gelöscht wird. Das Suchen bezieht sich auf die Spalte C und D und J__ und beginnt ab Zeile 4
Ich bräuchte auch die Möglichkeit, die Suche auf weitere Suchwörter zu erweitern.
Gibt es dafür eine Möglichkeit ?
Wenn ihr da eine gute Sache habt währe es toll wenn ich von euch Hilfe bekommen würde.
Schönen Abend noch
Klaus

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Unit() Dim Txt As Variant With ActiveSheet.Range("A4:K20") 'anpassen For Each Txt In Array("kath.", "Feuerwehr", "Sanitär", "Gemeinde", "Elektro") Union(.Columns(3), .Columns(4), .Columns(10)).Replace "*" & Txt & "*", True, xlPart Next With .Columns(.Columns.Count + 1) .FormulaR1C1 = "=IF(COUNTIF(RC3, TRUE) + COUNTIF(RC4, TRUE) + COUNTIF(RC10, TRUE)>0,TRUE,"""")" If WorksheetFunction.CountIf(.Cells, True) > 0 Then .SpecialCells(xlCellTypeFormulas, xlLogical).EntireRow.Delete .Cells.Clear End If End With End With End Sub

Moin,
eine Tabelle namens "Tabelle2" ist anzulegen, dort in A1 abwärts ohne Lücken, die Löschwörter reinschreiben ( u, die Spalte B muss leer sein).
Die "Grunddaten"-Tabelle muss ohne Leerzeichen zeichengenau so benannt sein.
Dann funtioniert es bei mir so:


Sub Unit_2()
Dim vntNegativliste As Variant, Bereich As Range, Txt As Variant
'Schlüssel
'Gemeinde
'Feuerwehr
'Kindergarten
'CARITAS
'Heizung
'Sanitär
'AWO
'Elektro
'Haustechnik
'Kath.
'bank
vntNegativliste = Worksheets("Tabelle2").Range("A1").CurrentRegion.Value
With Worksheets("Grunddaten")
Set Bereich = .Range("A4:J" & .Cells(.Rows.Count, "D").End(xlUp).Row) 'anpassen
End With
With Bereich
For Each Txt In vntNegativliste
Union(.Columns(3), .Columns(4), .Columns(10)).Replace "*" & Txt & "*", True, xlPart
Next
With .Columns(.Columns.Count + 1)
.FormulaR1C1 = "=IF(COUNTIF(RC3, TRUE) + COUNTIF(RC4, TRUE) + COUNTIF(RC10, TRUE)>0,TRUE,"""")"
If WorksheetFunction.CountIf(.Cells, True) > 0 Then
.SpecialCells(xlCellTypeFormulas, xlLogical).EntireRow.Delete
End If
.Cells.Clear
End With
End With
Set Bereich = Nothing
End Sub

Gruß Gerd

Beliebteste Forumthreads (12 Monate)

17 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread