Hallo Forum
Ich bin auf ein Problem gestossen, welches ich nicht so einfach lösen kann.
Ich habe zwei Personentabellen:
Tabelle A: ca. 40 - 50 Datensätze,
Tabelle B: ca. 60'000 Datensätze
Nun muss ich nach den existierenden Personen in der Tabelle B aus der Tabelle A suchen.
Klingt bislang eigentlich einfach
Problem.
Felder Tabelle A: Name, Strasse, PLZ, Ort, Wert 1, Wert 2
Felder Tabelle B: Vorname, Name, Strasse, PLZ, Ort
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.
Besten Dank für eure Hilfe
Gruss
marcoh
Hallo,
in VBA kann mit mit Range.Find(Name,,xlvalues, xlPart) nach dem Namen der Tabelle 1 in Tabelle 2 suchen.
Die Performance sollte "so-so" sein, richtig schnell wird es, wenn beide Tabellen zuerst in ein Array übergeben werden.
Es gibt die Möglichkeit, einen kleinen, aber aussagekräftigen Teil der Daten zu anonymisieren, dann könntest du eine Datei hochladen.
mfg
Hallo Fennek
Danke für deinen Input.
Also ich krieg die Suchergebnisse und markiere jeweils den ganzen range
danach versuche ich diesen range mittels Range.find zu durchsuchen. Klappt aber irgendwie nicht.
kann ich das einfach so anwenden?
Code:
Set ResultName = Range.Find(NamensfeldvonTabelleA, , xlValues, xlPart)
Dann muss ich irgendwie durch das Ergebnis iterieren
Ich bin ein bisschen weitergekommen
Code:
Sub Looping()
Sheets("Sheet2").Select
j = 0
'Application.ScreenUpdating = False
Dim stNow As Date
stNow = Now
Dim arr As Variant
arr = Sheets(1).Range("I2:I" & Sheets(1).Range("A" & Rows.Count).End(xlUp).Row).Value
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
Loop
rng.EntireRow.Select
Debug.Print x(0) & "....." & x(2)
End If
End If
Next
Debug.Print Chr(13) & "-->" & DateDiff("s", stNow, Now) & " sec"
Application.ScreenUpdating = True
End Sub
Die Sache ist, dass ich bei
Code:
rng.EntireRow.Select
hänge
Ich möchte da auf die Zelle vom Suchresultat zugreifen können. So kann ich z.B. auf die Zelle Nachname suchen.
Der rng.address des Suchresultats sieht z.B. so aus:
$S$17365,$S$57104,$S$71989:$S$71990,$S$72025:$S$72026,$S$15445
Also muss ich irgendwie den Range iterieren und suchen...
Hallo,
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.
mfg
Hallo Fennek
Besten Dank
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.
Hier habe ich was gefunden, das gibt einen Score aus für ähnlichkeit.
http://www.herber.de/forum/archiv/1256to...eigen.html
Ich versche mal dein Script so umzuschreiben, dass ich für die gefundenen Adressen, die Namen irgendwie finden.
Hallo,
ich bin ein Fan der "Regenechse", aber der Code bei Herber ist für deine Zwecke weit "over-the-top". Verliere dich nicht in komplexen Konstruktionen.
Mit den normalen Text-Funktionen solltest du deine Aufgabe lösen können.
mfg
der code funktioniert wunderbar.
Was meinst du mit normalen Textfunktion?
Wenn ich bei deinem Beispiel die "Anna Schuster" auf "Schuster Anna" wechsle, findet es sie nicht mehr
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
wowowowowooooo
was hast du hier gemacht?
Das sieht geil aus und könnte so klappen. Ich verstehs no nicht so ganz. Versuche es gleich in meine Tabellen einzufügen