Alle Werte einer Zelle teilen

Function AlleWerte _
(rErg As Range, _
sMatch As String, _
rMatch As Range, _
Optional sDelim As String = " ") _
As String
'rErg=Ergebnisspalte, sMatch=Suchbegriff
'rMatch=Suchspalte, sDelim=Trennzeichen
Dim objErg As Object, lngC As Long
Dim arrErg, arrMatch
Set objErg = CreateObject("Scripting.Dictionary")
arrErg = rErg.Value
arrMatch = rMatch.Value
For lngC = LBound(arrMatch) To UBound(arrMatch)
If arrMatch(lngC, 1) Like sMatch Then
objErg(objErg.Count + 1) = arrErg(lngC, 1)
End If
Next
AlleWerte = Join(objErg.items, sDelim)
End Function