Sub Uebersicht_Erstellen()
Dim Quelle As Worksheet, Ziel As Worksheet
Set Quelle = Sheets("Quelltabelle")
Set Ziel = Sheets("Zieltabelle")
lz = Quelle.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lz
arr = Split(Quelle.Cells(i, 2), ", ")
For Each x In arr
Datum = DateValue(Left(x, 10))
Platz = Mid(x, 13, 3)
Belegungen = Val(Mid(x, 18, 1))
Zeile = Application.Match(CLng(Datum), Ziel.Range("A:A"), 0)
Spalte = Application.Match(Platz, Ziel.Rows(1), 0)
If Not IsError(Zeile) And Not IsError(Spalte) Then
Ziel.Cells(Zeile, Spalte) = Ziel.Cells(Zeile, Spalte) + Belegungen * 10
End If
Next x
Next
End Sub