Sub test()
Dim dicX(1 To 2) As Scripting.Dictionary
Dim rngData As Excel.Range
Dim rngResult As Excel.Range
Dim strFA As String
Dim i&, j&
With Tabelle1.UsedRange
Set rngData = .Resize(.Rows.Count - 1).Offset(1)
End With
For i = 1 To 2
Set dicX(i) = CreateObject("Scripting.Dictionary")
Set rngResult = rngData.Columns(i).Find("X", LookIn:=xlValues, LookAt:=xlWhole)
If Not rngResult Is Nothing Then
strFA = rngResult.Address
Do
If Not dicX(i).Exists(rngResult.Offset(ColumnOffset:=Choose(i, 1, -1)).Text) Then
dicX(i).Add rngResult.Offset(ColumnOffset:=Choose(i, 1, -1)).Text, 1
Else
End If
Set rngResult = rngData.Columns(i).FindNext(rngResult)
Loop While rngResult.Address <> strFA
End If
Next i
For i = 0 To dicX(2).Count - 1
For j = 0 To dicX(1).Count - 1
Debug.Print dicX(2).Keys(j) & "/" & dicX(1).Keys(i)
Next
Next
Set rngResult = Nothing
Set rngData = Nothing
End Sub