Sub FarbIDs()
Dim oDic As New Scripting.Dictionary
Dim c As Range
Dim arr() As Variant, x As Long
Dim ari() As String, y As Long
For Each c In Sheets("ID-Zuordnungen").UsedRange.Columns(1).Cells
oDic.Add c.Value, c.Offset(, 1).Value
Next c
arr = Sheets("Klartext").UsedRange.Columns(1).Value
For x = LBound(arr, 1) To UBound(arr, 1)
ari = Split(arr(x, 1), ",")
For y = LBound(ari) To UBound(ari)
ari(y) = Replace(ari(y), ari(y), oDic.Item(Trim(ari(y))))
Next y
arr(x, 1) = Join(ari, ", ")
Next x
Sheets("IDs").Cells(1).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
End Sub