Makro mit zwei Schleifen verbessern

Guten Morgen
Vor ein paar Tagen habe ich ein ähnliches Thema gepostet.
Ich erstelle eine Tageseinnahmestatistik, hier sollen sich vergleichsformlen und so etwas für das ganze Jahr automatisch erstellen.
Außerdem wird eine Datumsliste erstellt - für jeden Werktag (bei mir Montag bis Samstag) erfolgt der Eintrag des Datums.
In der Beispieldatei auf den fetten Button klicken, dann sollte alles klar sein :)
Jedoch habe ich noch 2 Probleme.
Im Blatt "Einstellungen" gibt es eine Liste der Feiertage.
Für diese sollen natürlich ebenfalls keine Daten eingetragen werden, das bekomme ich aber nicht in meine "Sonntagsabfrage" eingebaut.
Das zweite ist, dass dieser Code mit Sicherheit einiges verbessert, bzw. verkürzt werden könnte.
Hierbei bitte ich euch um Hilfe :)

Die Datei https://www.herber.de/bbs/user/112055.xlsm wurde aus Datenschutzgründen gelöscht

Für den der die Datei nicht laden möchte hier der Code:
Die Feiertage stehen in Einstellungen A16 - A27 untereinander

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi,
da die Zeilenstruktur von Jahr zu Jahr gleichbleibt, kopiert das Makro das alte ins neue Jahr, incl. aller Daten (Überschriften), Formeln und Formate: dann muß nur noch geändert werden, was zu ändern ist.
Die Feiertage werden in einen String eingelesen, mit "|" getrennt, und dann schlicht mit instr verglichen.
Makro:

Sub neuesJahr()
Dim k&, j&, l&, i&
Dim datum As Date
Dim c As Range, FT
Dim monat   ' als Array...
ReDim monat(1 To 30, 1 To 1)
For Each c In Sheets("Einstellungen").Range("A16:A27")
FT = FT & "|" & c.Value
Next
'Stop
datum = "01.01." & Year(Date)
With Worksheets("Statistik")
'Einfügen der neuen Spalten
.Columns("E:R").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
.Range("s1:AF400").Copy .Range("E1")
'Schreiben der Werte
.Range("E1").Value = Year(Date)
' Start der äußeren Schleife - für jeden Monat
l = 3
For k = 1 To 12
intAnzahlTage = Day(DateSerial(Year(datum), Month(datum) + 1, 0))
'      Stop
With .Range("E" & l)
'Monatsname
monat(1, 1) = Format(datum, "MMMM")
'innere Schleife für jeden Tag im Monat
j = 1
For i = 1 To intAnzahlTage
' If datum = "28.04.2017" Then Stop ' au wei, der 30. ist ein Sonntag = alles gut
'Prüfen ob Datum KEIN Sonntag ist
If Weekday(datum, 2)  7 And InStr(FT, datum) = 0 Then
j = j + 1
'Schreiben des *Tags* und erhöhen des "Offset" Zählers
monat(j, 1) = Day(datum)
End If
'nächster Tag
datum = datum + 1
Next
For i = j + 1 To 30: monat(i, 1) = "": Next ' Monat + max. 29 Tage...
.Resize(30, 1) = monat
End With
.Range("F" & l + 1 & ":M" & l + 29).ClearContents
'l um 33 erhöhen, damit nächster Monat an richtiger Stelle geschrieben wird
l = l + 33
'       Stop
Next
End With
End Sub

Datei: https://www.herber.de/bbs/user/112065.xlsm
Schöne Grüße,
Michael

Beliebteste Forumthreads (12 Monate)

Makro mit zwei Schleifen verbessern

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread