Das Feld Name der Tabelle A kann sein: [Vorname Name], [Vorname zweiter Vorname Name], [Nachname Vorname] usw.. Trennzeichen gibt es nicht. Nur Abstand.
Mein Ansatz bisher:
Ich mache ein Suchfeld für beide Tabellen:
Tabelle A Suchfeld: Strasse$$PLZ$$Ort//Wert1$$Wert2
Tabelle B Suchfeld: Strasse$$PLZ$$Ort
So erhalte ich einen guten Filter.
Jetzt muss ich aber noch schauen, ob der Name von Tabelle A im Suchergebnis der erscheint, damit ich dann Wert 1 und Wert 2 anhängen kann.
Habt ihr mir einen Vorschlag?
Für ein Lookup oder match Funktion ist das glaube ich zu viel, oder kann man da mit Wildcards arbeiten?
Ich habe es mit VBA und Arrays schon recht weit gebracht. Die Performance ist aber ziemlich schlecht, wenn ich da durch ein 60k grosses Array iterieren muss.
Dim varr As Variant
varr = Sheets(2).Range("S2:S" & Sheets(2).Range("A" & Rows.Count).End(xlUp).Row).Value
Dim x, y, match As Boolean
For Each x In arr
x = Split(x, "//")
match = False
For Each y In varr
If x(0) = y Then match = True
j = j + 1
Next y
If match Then
If x(0) <> "$$" Then
'======================
Dim FirstFound As String
Dim FoundCell As Range, rng As Range
Dim myRange As Range, LastCell As Range
Dim SelectionData As Variant
Set myRange = ActiveSheet.UsedRange
Set LastCell = myRange.Cells(myRange.Cells.Count)
Set FoundCell = myRange.Find(What:=x(0), After:=LastCell, LookIn:=xlValues)
'Test to see if anything was found
If Not FoundCell Is Nothing Then
FirstFound = FoundCell.Address
Else
GoTo NothingFound
End If
Set rng = FoundCell
'Loop until cycled through all unique finds
Do Until FoundCell Is Nothing
'Find next cell with fnd value
Set FoundCell = myRange.FindNext(After:=FoundCell)
'Add found cell to rng range variable
Set rng = Union(rng, FoundCell)
'Test to see if cycled through to first found cell
If FoundCell.Address = FirstFound Then Exit Do
bei so vielen Datensätzen ist es schneller, wenn man mit Array arbeitet:
Code:
Sub T_1()
Ar = Tabelle1.Range("A1").CurrentRegion
Br = Tabelle2.Range("A1").CurrentRegion
For i = 2 To UBound(Ar)
N = Split(Ar(i, 1))
Nm = N(UBound(N))
For ii = 2 To UBound(Br)
If Br(ii, 2) = Nm Then
Tabelle2.Cells(ii, 2).Interior.Color = vbYellow
Exit For
End If
Next ii
Next i
End Sub
Der Code passt mit den Daten aus dem Sheet. Wenn es mehrfache Namen geben sollte, musst Du noch die Adressen prüfen.
Das Problem ist wie gesagt, dass das Namensfeld beliebige Kombinationen von Vorname und Nachname haben kann. Darum gehe ich zuerst auf die Adresse, weil die Einmalig ist.
28.09.2018, 12:36 (Dieser Beitrag wurde zuletzt bearbeitet: 28.09.2018, 12:37 von snb.)
Warum verwendest du kein Autofilter ?
Und VBA's Filter ist inhärent xlPart
Code:
Sub M_snb()
sn = Tabelle2.Range("A1").CurrentRegion.Resize(, Tabelle1.Range("A1").CurrentRegion.Columns.Count + 1)
Tabelle1.Range("A1").CurrentRegion.Copy
With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
.GetFromClipboard
sp = Split(.GetText, vbCrLf)
End With
For j = 2 To UBound(sn)
sq = sp
For jj = 1 To UBound(sn, 2) - 1
sq = Filter(sq, sn(j, jj))
Next
If UBound(sq) > -1 Then sn(j, jj) = "OK"
Next
Tabelle2.Range("A1").CurrentRegion.Resize(, Tabelle1.Range("A1").CurrentRegion.Columns.Count + 1) = sn
End Sub