Namenslisten auf Veränderungen vergleichen

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

Hallo Claus,

vielen Dank, das Makro funktioniert super!

Ich stehe jetzt aber vor einem neuen Problem:

Ich habe Personalnummern in einer der Listen die ich mit einem SVERWEIS abgreifen will, einige davon haben jedoch einen Präfix, bspw. alt_xxxx usw. Es gibt den gleichen Namen jedoch teilweise einmal mit und einmal ohne Präfix, sowie anderer P-Nr.

Wie kann ich Excel jetzt dazu bringen, dass wenn eine P-Nr. mit Präfix und eine ohne bei gleichem Namen gefunden wird, immer die P-Nr. ohne Präfix zurückgegeben wird?

Danke noch mal!

Viele Grüße