Sub DatumEinfuegenA5A9A13A17A21A25A29_plusA2()
'In->Tabelle1' muß A5 als Datum formatiert und ausgefüllt sein
'Alle weiteren Tabellen, deren Tabellenname mit Tabelle anfängt,
'werden dann automatisch ausgefüllt.
'Aus der Nummer im Tabellennamen wird die Distanz in Wochen zu
'dem Datum in->Tabelle1' errechnet,
'z.B. Tabelle1 zu Tabelle5 entspricht 28Tage.
'Die Tabellennamen müssen daher lückenlos aufsteigend nummeriert sein.
-><<< A N P A S E N >>>
Const c_TAB_NAME_WURZEL = Tabelle
Const c_ANFANG_MIT_TABNR = 1
-><<< A N P A S E N E N D E >>>
Const c_FORMAT_DATUM = dd.mm.yyyy
Const c_FORMAT_VONBIS = d.m.
->Range der Tage
Dim RangeDer7Tage As Variant
RangeDer7Tage = Array(A5, A9, A13, A17, A21, A25, A29)
Const c_TAGVONBIS = A2
Dim wb As Workbook, ws As Worksheet
Dim TabName As String, dAnfDatum As Date
Dim Tabnr As Long, dDatum As Date, y As Long
->aktive Mappe setzen
Set wb = ActiveWorkbook
->Tabellenname für Anfangsdatum
TabName = c_TAB_NAME_WURZEL & c_ANFANG_MIT_TABNR
On Error Resume Next
Set ws = wb.Worksheets(TabName)
If Err.Number <> 0 Then Err.Clear
If ws Is Nothing Then
MsgBox Anfangsblatt & TabName & nicht vorhanden.
GoTo AUFRAEUMEN
End If
->Anfangsdatum prüfen
If Not IsDate(ws.Range(RangeDer7Tage(0)).Value) Then
MsgBox RangeDer7Tage(0) & auf dem Anfangsblatt & TabName & enthält kein Datum.
GoTo AUFRAEUMEN
End If
->Anfangsdatum holen
dAnfDatum = ws.Range(RangeDer7Tage(0))
Tabnr = c_ANFANG_MIT_TABNR - 1
Do
->nächster Tabellenname
Tabnr = Tabnr + 1
TabName = c_TAB_NAME_WURZEL & Tabnr
->Tabellenblatt sezen
On Error Resume Next
Set ws = wb.Worksheets(TabName)
If Err.Number <> 0 Then
Err.Clear
MsgBox _
Ende, weil Blatt & TabName & nicht gefunden. & vbLf & _
Bearbeitet wurden die Blätter & _
c_TAB_NAME_WURZEL & & c_ANFANG_MIT_TABNR & - & (Tabnr - 1)
GoTo AUFRAEUMEN
End If
->Anfangsdatum des Blattes bestimmen
dDatum = dAnfDatum + 7 * (Tabnr - c_ANFANG_MIT_TABNR)
->Datum formatieren und eintragen
For y = 0 To 6
With ws.Range(RangeDer7Tage(y))
.NumberFormat = c_FORMAT_DATUM
.Value = dDatum + y
End With
Next
->Von - Bis in A2 (als Text)
With ws.Range(c_TAGVONBIS)
.NumberFormat = @
.Value = Format(dDatum, c_FORMAT_VONBIS) & - & Format(dDatum + 6, c_FORMAT_VONBIS)
End With
Loop
AUFRAEUMEN:
Set wb = Nothing: Set ws = Nothing
End Sub
und erst recht mit den funktionen! ich habe dies probiert: