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, 13:36 (Dieser Beitrag wurde zuletzt bearbeitet: 28.09.2018, 13: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
