Sub Vorschlag()
Dim ArtikelNr As Variant, Lander As Variant
Dim dic As Object
Dim i As Long
Dim Land As Variant
Set dic = CreateObject("Scripting.Dictionary")
ArtikelNr = Array(1, 2, 3, 4, 5, 6)
Lander = Split("DE,DE,DE,ES,ES,FR", ",")
For i = 0 To UBound(ArtikelNr)
If dic.exists(Lander(i)) Then
dic(Lander(i)) = dic(Lander(i)) & vbCrLf & CStr(ArtikelNr(i))
Else
dic(Lander(i)) = CStr(ArtikelNr(i))
End If
Next
For Each Land In dic.keys
Debug.Print "In """ & Land & """ gibt es folgende Nummern:" & vbCrLf & dic(Land)
Next
End Sub