Zellinhalte zweier Dateien miteinander vergleichen

Hallo Chris,

vielen Dank für deine Nachricht.

Dein Anliegen ist klar. Nach Rücksprache mit den Experten würde ich dich gerne an das Excel Forum verweisen:

Microsoft Excel Forum


Microsoft Tech Community

Letzeres wäre auf Englisch, falls das für dich kein Problem darstellt.

Falls du natürlich weitere Fragen hast, stehe ich dir gerne zur Verfügung.

Viele Grüße

Laura

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

Hallo Claus,

danke für dein Makro, soweit ich es nachvollzogen hab macht es genau das was ich mir vorgestellt habe! Nur leider bekomme ich in Zeile 18 einen Laufzeitfehler 91, da die InStr. Funktion nicht definiert scheint?

Ich habe schon etwas probiert grade, aber den Fehler bekomme ich nicht ausgeschaltet?

Danke dir noch mal!

VG