Datenreihe | Herbers Excel-Forum | HERBERS Excel Forum

Einen schönen Sonntag zusammen,
ich habe hier mal eine Mappe hochgeladen, welche mir mal wieder Kopfzerbrechen bereitet.
https://www.herber.de/bbs/user/67115.xls
In die Spalten A + B soll das Datum eingefügt werden. In Spalte A als Wochentag in Spalte B als reguläres Datum. (Wobei diese Formatierung für Spalte A nur das sekundäre Problem ist).
Ich möchte das nach dem letzen eines Monats (Januar bis einschließlich November) eine Leerzeile eingefügt wird. Nun das geht auch über die vielen if / then Anweisungen. Vieleicht nicht elegant, aber funktioniert. Jetzt bereitet mir aber der Februar in einem Schaltjahr Probleme.
Ich hab schon versucht das mit der Funktion IstSchaltjahr zu lösen, aber... war wohl nichts.
Könnte mir jemand sagen wie ich die Fehler beseitige?
Danke und Gruß
Volker

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi
weiß nicht, ein Makro ist sehr aufwendig, im Prinzip lässt sich das ganze doch über eine Formel lösen.
das ganze ist so schnell, daß es keinen Fortschrittsbalken braucht.

Sub NeuesJahr()
Dim Anz As Long
Dim dat1 As Date, dat2 As Date
dat1 = DateSerial(Cells(1, 2), 1, 1)
dat2 = DateSerial(Cells(1, 2) + 1, 1, 1)
'Anzahl Tage ermitteln (Schaltjahr-Test)
Anz = dat2 - dat1 + 11
'Kalender einfügen, erster Tag fix, rest über Formel
Cells(3, 1).Resize(1, 2).Value = dat1
With Cells(4, 1).Resize(Anz - 1, 2)
.FormulaR1C1 = _
"=IF(R[-1]C="""",R[-2]C+1,IF(R[-1]C=DATE(YEAR(R[-1]C),MONTH(R[-1]C)+1,0),"""",R[-1]C+1))"
.Formula = .Value
End With
'Datumsformat festlegen
Cells(3, 1).Resize(Anz, 1).NumberFormat = "DDDD"
Cells(3, 2).Resize(Anz, 1).NumberFormat = "DD.MM.YYYY"
'Färben, Farbindex und Spaltennummer für Hilfsspalte ggf anpassen
With Cells(3, 3).Resize(Anz, 1)
.FormulaR1C1 = "=IF(RC2="""",False,IF(ISEVEN(RC2),1,""x""))"
Intersect(Range("A:B"), .SpecialCells(xlCellTypeFormulas, 1).EntireRow).Interior.ColorIndex = 3
Intersect(Range("A:B"), .SpecialCells(xlCellTypeFormulas, 2).EntireRow).Interior.ColorIndex = 5
.ClearContents
End With
End Sub

Gruß, Daniel

Sub tt() Dim i%, x% Dim start As Date, Ende As Date, Y% Columns(1).ClearContents Y = Range("D1") start = DateSerial(Y, 1, 1) Ende = "31.12." & Year(start) For i = 1 To 377 If start > Ende Then Exit For Cells(i, 1) = start start = start + 1 If Month(start) > Month(start - 1) Then i = i + 1 End If Next i End Sub

Beliebteste Forumthreads (12 Monate)

Datenreihe | Herbers Excel-Forum

19 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

19
Beiträge zum Forumthread

Beiträge zu diesem Forumthread