ich habe es mal uminterpretiert:
Tabelle1
„Projekt Hamburg“; Max Muster; 3 Tage
„Projekt Berlin“; Max Muster, 4 Tage
„Projekt Mainz“; Bernd Becker; 2 Tage
etc.
Tabelle2
;; ;; ;;;;;;;
etc.; ;etc.; ;etc.
Meine Lösung:
Sub Zeitstrahl()
Set ws1 = Worksheets(„Tabelle1“) ’ Anpassen
Set ws2 = Worksheets(„Tabelle2“) ’ Anpassen
Set wf = WorksheetFunction
Dim Zeile&(1 To 256), Datum&(1 To 256), Start&
Start = DateValue(Right(InputBox(„Anfangsdatum“, , Format(Now, „DDD DD.MM.YY“)), 8))
With ws2
.Cells.Clear
Set Ueberschrift = .Range(„1:1“)
With .Range(„A1“)
.Value = ws1.Range(„B1“) ’ Erster Zuständiger
.EntireColumn.NumberFormat = „DDD DD.MM.YY“
End With
Zeile(1) = 2
Datum(1) = Start
End With
With ws1
For Each Projekt In Intersect(.UsedRange, .Range(„A:A“))
On Error Resume Next
Spalte = wf.Match(Projekt.Offset(0, 1), Ueberschrift, False)
If Err.Number = 1004 Then ’ Neuer Zuständiger
With ws2
Spalte = .UsedRange.Columns.Count + 2
With .Cells(1, Spalte)
.Value = Projekt.Offset(0, 1)
.EntireColumn.NumberFormat = „DDD DD.MM.YY“
End With
Zeile(Spalte) = 2
Datum(Spalte) = Start
End With
End If
On Error GoTo 0
For Zeile(Spalte) = Zeile(Spalte) To Zeile(Spalte) + Projekt.Offset(0, 2) - 1
With ws2.Cells(Zeile(Spalte), Spalte)
.Value = Datum(Spalte)
.Offset(0, 1).Value = Projekt
End With
Datum(Spalte) = Datum(Spalte) + 1
If Weekday(Datum(Spalte)) = 7 Then Datum(Spalte) = Datum(Spalte) + 2 ’ Wochenende
Next Zeile(Spalte)
Next Projekt
End With
End Sub