VLOOKUP mit mehrere Treffer ohne Duplikate

[cysu11]

Hallo zusammen,

ich habe noch ein Problem beim dem ich nicht weiterkomme. Ich würde gerne per VBA, dass wenn ich z.B. in Zelle A100 einen Wert eingebe, geprüft werden soll ob dieser Wert bereits in der Spalte A vorhanden ist(kann mehrere Male vorkommen, wenn ja, dann soll in einer MSGBOX jeweils der Wert aus der Zeile wo der Wert vorkommt aus Spalte G ausgegeben werden, allerdings ohne Duplikate. D.h. wenn der Wert aus A100 in der Spalte A dreimal gefunden wird, und bei zwei davon steht rot in der Spalte G und bei einen davon steht grün in Spalte G, dann soll in der MSGBOX natürlich nur 1x rot und 1x grün angezeigt werden...

Ich hoffe es ist einigermaßen verständlich was ich meine! :)

Vielen lieben Dank im Voraus
LG, Alexandra

[Oberon]

Hi,

versuch es mal so:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim SearchRng As Range, FindRng As Range
Dim firstAd As String
Dim FindText As String
Dim Key As Variant
Dim d As Object
Set d = CreateObject("Scripting.Dictionary")
FindText = "Vorhandene Werte:" & vbCrLf & vbCrLf
    If Not Intersect(Target, Worksheets("Tabelle1").Range("A:A")) Is Nothing Then
        Set SearchRng = Worksheets("Tabelle1").Range("A2:A" & Target.Row - 1)
        Set FindRng = SearchRng.Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not FindRng Is Nothing Then
            firstAd = FindRng.Address
            Do
                d.Item(Worksheets("Tabelle1").Range("G" & FindRng.Row).Value) = Target.Row
                Set FindRng = SearchRng.FindNext(FindRng)
            Loop While (Not FindRng Is Nothing) And (FindRng.Address <> firstAd)
        End If
        For Each Key In d.Keys
            FindText = FindText & Key & vbCrLf
        Next
    End If
    If d.Count > 0 Then
        MsgBox FindText
    End If
End Sub

CU
Oberon

[cysu11]

Hallo Oberon,

suuuper, das klappt perfekt, genauso wie ich es wollte.

Vielen lieben Dank dafür & ein schönes Wochenende!! :)

LG, Alexandra