Zwei Excelliste miteinander vergleichen und fehlende Einträge aus liste 1 in liste 2 ergänzen

Ist das mit Excel realisierbar mittels einfacher Formeln, oder ist es einfacher 10.000+ Einträge zu untersuchen?

Weder noch.
<br />Man kopiert alle Daten untereinander.
Dann sortiert man.
<br />Dann entfernt man die doppelten bei Berücksichtigung aller Spalten (diese entstehen wenn in 2 Dateien die gleichen Datensätze stehen)
<br />Dann erstellt man in der Tabelle einen Datenschnitt und kann sich so eine ID filtern und schauen ob es mehrere Datensätze gibt und diese vergleichen.
<br />Das zusammenfassen / kopieren mehrerer Zeilen lässt man lieber, das rächt sich irgendwann wenn man Analysen machen will.
Außerdem ist das nicht so ganz trivial.
<br />Andreas.
<br />https://www.youtube.com/watch?v=yL11ugShdrk
<br />

Hallo Andreas,
<br />Danke für die schnelle Antwort...
<br />Leider sind es schier Unmengen an Daten - und keine Zeile ist doppelt. Über 10.000, um genau zu sein, mit jeweils 8 Spalten, die leider nicht jedesmal ausgefüllt sind. Und eben ohne einen Querverweis...
<br />Dann werde ich mir lieber über die Suche jedesmal 10 oder mehr Spalten anzeigen lassen.
<br />

Hallo Rico,

sorry, mein Fehler. Probiere es mal mit folgendem Code. Sollte es dann immer noch nicht laufen, poste mal Beispiele deiner Daten.

Sub PersID()

Dim varCheck As Variant, varOut() As Variant

Dim i As Long, n As Long, LRow As Long

Dim myRng As Range, c As Range

Dim FirstAddress As String'Bereich mit Namen zu denen die PersID gesucht wird

varCheck = Sheets("Tabelle2").Range("A1:A10")

ReDim Preserve varOut(UBound(varCheck) - 1)'Tabelle in der gesucht wird

With Sheets("Tabelle1")

    LRow = .Cells(Rows.Count, 1).End(xlUp).Row

     'Namen in A PersID in B

    Set myRng = .Range("A1:B" & LRow)

    For i = LBound(varCheck) To UBound(varCheck)

        Set c = myRng.Find(varCheck(i, 1), LookIn:=xlValues)

        If Not c Is Nothing And InStr(c.Offset(, 1), "alt") = 0 Then

            varOut(n) = c.Offset(, 1)

            n = n + 1

        ElseIf Not c Is Nothing And InStr(c.Offset(, 1), "alt") > 0 Then

            FirstAddress = c.Address

            Do

                Set c = myRng.FindNext(c)

            Loop While InStr(c.Offset(, 1), "alt") > 0 And c.Address <> FirstAddress

            varOut(n) = IIf(InStr(c.Offset(, 1), "alt") = 0, c.Offset(, 1), "")

            n = n + 1

        End If

    Next

End With

Sheets("Tabelle2").Range("B1").Resize(n) = Application.Transpose(varOut)

End Sub

Claus

Hallo Rico,

das macht das Makro doch. Wenn eine Zelle leer bleibt, dann nur, weil der Name nicht gefunden wurde.

Das Makro schreibt alle gefundenen PersIDs und ihre Länge in ein Array. Dann wird die kürzeste ID gesucht und ausgegeben. Wenn nur IDs mit Präfix vorhanden sind, wird diese als die kürzeste gefunden und eingetragen.

Claus

Hallo Rico,

jetzt mit dem Teilstring:

Sub PersID()

Dim varCheck As Variant, varData As Variant

Dim varOut() As Variant, varTmp() As Variant, varStr As Variant

Dim i As Long, j As Long, n As Long, z As Long

Dim LRow As Long, myCnt As Long

Dim myRng As Range, c As Range

Dim FirstAddress As String, myStr As String'Bereich mit Namen zu denen die PersID gesucht wird

varCheck = Sheets("Auswertung").Range("A2:A4")

ReDim Preserve varOut(UBound(varCheck) - 1)'Tabelle in der gesucht wird

With Sheets("Stammdaten")

    LRow = .Cells(Rows.Count, 1).End(xlUp).Row

    Set myRng = .Range("A2:A" & LRow)

End WithFor i = LBound(varCheck) To UBound(varCheck)

    n = 0

    Erase varTmp

    varStr = Split(varCheck(i, 1), " ")

    myStr = varStr(LBound(varStr)) & "*" & varStr(UBound(varStr))

    myCnt = Application.CountIf(myRng, myStr)

    Set c = myRng.Find(myStr, LookIn:=xlValues)

    If Not c Is Nothing Then

        FirstAddress = c.Address

        Do

            ReDim Preserve varTmp(myCnt - 1, 1)

            varTmp(n, 0) = c.Offset(, 4)

            varTmp(n, 1) = Len(c.Offset(, 4))

            n = n + 1

            Set c = myRng.FindNext(c)

        Loop While Not c Is Nothing And c.Address <> FirstAddress

    End If

    With Application

        j = .Match(.Min(.Index(varTmp, 0, 2)), .Index(varTmp, 0, 2), 0)

        varOut(z) = varTmp(j - 1, 0)

        z = z + 1

    End With

Next

Sheets("Auswertung").Range("C2").Resize(z) = Application.Transpose(varOut)

End Sub

Claus