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