AW: Suche von Texten und Zahlen
21.05.2013 18:46:54
Texten
Hallo,
habe den Code etwas flexibler gemacht und kommentiert.
Spiele mal in der Zieltabelle mit den Überschriften.
Sub Filter_Daten()
Dim wksZ As Worksheet, rng As Range
Dim wksQ As Worksheet, nRow&
Dim strFormel$
Set wksZ = Worksheets("SUCHEN")
Set wksQ = Worksheets("Datenbank")
With wksQ
With .UsedRange
'Hilfsformel erstellen um die Zellen der Zeile zu Verketten
For nRow = 1 To .Columns.Count
strFormel = strFormel & "RC[-" & nRow & "]&"
Next nRow
'letztes Zeichen & entfernen
strFormel = Left$(strFormel, Len(strFormel) - 1)
'nächste 2 Zellen neben benutzten Bereich
Set rng = .Columns(.Columns.Count).Offset(, 1).Cells(1, 1).Resize(2, 1)
On Error GoTo ErrorHandler: 'sollte ein Fehler entstehen
'Hilfsformel für den Spezialfilter schreiben
'Formel ergibt z.Bsp. =ISTFEHL(FINDEN(SUCHEN!$A$1;D2&C2&B2&A2))=FALSCH
rng.Cells(2, 1).FormulaR1C1 = "=ISERR(FIND(SUCHEN!R1C1," & strFormel & "))=FALSE"
'Spezialfilter anwenden
'Ziel ist Tabelle Suchen A2 bis zu letzten in Zeile 2
'Keine Überschriften verwenden die nicht in der Datenbank vorkommen!!!!
.AdvancedFilter xlFilterCopy, rng, wksZ.Range("A2", wksZ.Cells(2, wksZ.Columns.Count).End(xlToLeft))
ErrorHandler:
'Hilfsspalte löschen
If Not rng Is Nothing Then rng.EntireColumn.Delete
End With
End With
If Err.Number <> 0 Then 'Meldung bei Fehler
MsgBox Err.Description, _
vbCritical + vbMsgBoxSetForeground + vbMsgBoxHelpButton, _
"Error: " & Err.Number, Err.HelpFile, Err.HelpContext
End If
End Sub
Gruß Tino