Arbeitstage monatsweise aufdröseln

[schauan]

Hallo zusammen,

heute hab ich auch mal wieder eine Frage. War wieder beizeiten unterwegs und mir fallen nun eher die Augen zu als Gedanken für Lösungen
Ich hab eine Übersicht von Zeitangaben "von bis", die zum Teil auch die Monatsgrenzen überschreiten. Maximal sind aus jetziger Sicht 3 Monate in einer Zeile enthalten, siehe hier Zeile 5. Pro Monat kann es aber mehrere Abschnitte geben, siehe Zeilen 2, 3 und 4 mit Daten vom Januar. Die Angaben betreffen jeweils ein Jahr, ohne Überschreitung der Jahresenden. Hier mal ein Auszug als Beispiel. In Spalte F meine "Nebenrechnung". Unter dem Auszug stehen die Feiertage des Beispielzeitraumes.  

Ich brauche nun eine Gesamtübersicht der Tage je Monat. Vorteilhaft wäre eine Lösung ohne Hilfsspalten. Hat da jemand was in Petto  

Tabellenblattname: Tabelle1

	A	B	C	D	E	F
1	von	bis		Monat	Tage	sind wohl
2	04.01.2016	10.01.2016		Januar		14
3	12.01.2016	15.01.2016		Februar		7
4	25.01.2016	05.02.2016		März		21
5	24.02.2016	04.04.2016		April		2
6
7	Feiertage
8	06.01.2016
9	25.03.2016
10	28.03.2016

© schauan

[shift-del]

Vorteilhaft wäre eine Lösung ohne Hilfsspalten.

Ob das wirklich vorteilhaft ist?

Arbeitsblatt mit dem Namen 'Tabelle1 (2)'
	A	B	C	D	E	F
1	von	bis		Monat	Tage	sind wohl
2	04.01.2016	10.01.2016		Januar	13	14
3	12.01.2016	15.01.2016		Februar	9	7
4	25.01.2016	05.02.2016		März	21	21
5	24.02.2016	04.04.2016		April	2	2
6
7	Feiertage
8	06.01.2016
9	25.03.2016
10	28.03.2016

Zelle	Formel
E2	{=SUMME(WENN(NETTOARBEITSTAGE(WENN(A$2:A$5>=--(1&D2);A$2:A$5;--(1&D2));WENN(B$2:B$5<=MONATSENDE(--(1&D2);0);B$2:B$5;MONATSENDE(--(1&D2);0));$A$8:$A$10)<0;0;NETTOARBEITSTAGE(WENN(A$2:A$5>=--(1&D2);A$2:A$5;--(1&D2));WENN(B$2:B$5<=MONATSENDE(--(1&D2);0);B$2:B$5;MONATSENDE(--(1&D2);0));$A$8:$A$10)))}

Achtung, Matrixformel enthalten!

Die geschweiften Klammern{} werden nicht eingegeben.

Verlassen Sie den Zelleneditor mit Strg+Shift + Enter, statt Enter alleine.

Diese Tabelle wurde mit Tab2Html (v2.4.1) erstellt. ©Gerd alias Bamberg

[IchBinIch]

Hi,

vielleicht (?) nicht flexibel genug aber als Ansatz:

Sub ArbeitstageProMonat()
Dim at1 As Long, at2 As Long, at3 As Long, at4 As Long, z As Long

For z = 2 To 5
    If Month(Cells(z, 2)) - Month(Cells(z, 1)) = 0 Then
        at1 = at1 + Application.WorksheetFunction.NetworkDays(Cells(z, 1), Cells(z, 2), Range("A8:A10"))
    ElseIf Month(Cells(z, 2)) - Month(Cells(z, 1)) = 1 Then
        at1 = at1 + Application.WorksheetFunction.NetworkDays(Cells(z, 1), Application.WorksheetFunction.EoMonth(Cells(z, 1), 0), Range("A8:A10"))
        at2 = at2 + Application.WorksheetFunction.NetworkDays(DateSerial(Year(Cells(z, 2)), Month(Cells(z, 2)), 1), Cells(z, 2), Range("A8:A10"))
    ElseIf Month(Cells(z, 2)) - Month(Cells(z, 1)) = 2 Then
        at2 = at2 + Application.WorksheetFunction.NetworkDays(Cells(z, 1), Application.WorksheetFunction.EoMonth(Cells(z, 1), 0), Range("A8:A10"))
        at3 = at3 + Application.WorksheetFunction.NetworkDays(DateSerial(Year(Cells(z, 1)), Month(Cells(z, 1)) + 1, 1), _
            Application.WorksheetFunction.EoMonth(DateSerial(Year(Cells(z, 1)), Month(Cells(z, 1)) + 1, 1), 0), Range("A8:A10"))
        at4 = at4 + Application.WorksheetFunction.NetworkDays(DateSerial(Year(Cells(z, 2)), Month(Cells(z, 2)), 1), Cells(z, 2), Range("A8:A10"))
    End If
Next z
    Debug.Print "Januar: " & at1
    Debug.Print "Februar: " & at2
    Debug.Print "März: " & at3
    Debug.Print "April: " & at4
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0

Gruß
Ich

[schauan]

Hallöchen,

danke für die Lösungen, funktionieren beide perfekt

[schauan]

Hallöchen,

ich habe den Code mal noch etwas angepasst. Es gab wohl ein Problemchen, wenn ich nicht in jedem Monat Daten hatte.

Ich habe dann auch noch den Datenbereich zu einem Listobjekt zusammengefasst (Menü "Einfügen | Tabelle") und den Bereich mit den Feiertagen entsprechend benannt. Der Code sieht jetzt so aus:

Code:

Sub ArbeitstageProMonat()
Dim rngFeier As Range
Dim arrMonth(1 To 12)
Dim iMonth1 As Integer, iMonth2 As Integer, iCnt As Integer
Set rngFeier = ThisWorkbook.Worksheets("Tabelle1 (2)").Range("Feiertage")
With ThisWorkbook.Worksheets("Tabelle1 (2)").ListObjects("Tabelle1")
    For iCnt = 1 To 12
      iMonth1 = Month(.DataBodyRange(iCnt, 1))
      iMonth2 = Month(.DataBodyRange(iCnt, 2))
      If iMonth2 - iMonth1 = 0 Then
        arrMonth(iMonth1) = arrMonth(iMonth1) + _
          Application.WorksheetFunction.NetworkDays(.DataBodyRange(iCnt, 1), .DataBodyRange(iCnt, 2), rngFeier)
      ElseIf iMonth2 - iMonth1 = 1 Then
        arrMonth(iMonth1) = arrMonth(iMonth1) + _
          Application.WorksheetFunction.NetworkDays(.DataBodyRange(iCnt, 1), Application.WorksheetFunction.EoMonth(.DataBodyRange(iCnt, 1), 0), rngFeier)
        arrMonth(iMonth2) = arrMonth(iMonth2) + _
          Application.WorksheetFunction.NetworkDays(DateSerial(Year(.DataBodyRange(iCnt, 2)), Month(.DataBodyRange(iCnt, 2)), 2), .DataBodyRange(iCnt, 2), rngFeier)
      ElseIf iMonth2 - iMonth1 = 2 Then
        arrMonth(iMonth1) = arrMonth(iMonth1) + _
          Application.WorksheetFunction.NetworkDays(.DataBodyRange(iCnt, 1), Application.WorksheetFunction.EoMonth(.DataBodyRange(iCnt, 1), 0), rngFeier)
        arrMonth(iMonth1 + 1) = arrMonth(iMonth1 + 1) + _
          Application.WorksheetFunction.NetworkDays(DateSerial(Year(.DataBodyRange(iCnt, 1)), Month(.DataBodyRange(iCnt, 1)) + 1, 2), _
            Application.WorksheetFunction.EoMonth(DateSerial(Year(.DataBodyRange(iCnt, 1)), Month(.DataBodyRange(iCnt, 1)) + 1, 2), 0), rngFeier)
        arrMonth(iMonth2) = arrMonth(iMonth2) + _
          Application.WorksheetFunction.NetworkDays(DateSerial(Year(.DataBodyRange(iCnt, 2)), Month(.DataBodyRange(iCnt, 2)), 2), .DataBodyRange(iCnt, 2), rngFeier)
      End If
    Next
End With
Sheets("Tabelle1 (2)").Range("E2:E13").Value = WorksheetFunction.Transpose(arrMonth)
End Sub

[snb]

Code:

Sub M_snb()
   sn = Cells(1).CurrentRegion                                               '   Daten
   sp = Cells(7, 1).CurrentRegion                                            '  Feiertage
   ReDim sq(Val(Format(DateSerial(year(sn(2,1)), 12, 31), "y")))           ' Das ganze Jahr 2016
   ReDim st(12, 0)                                                                 '  12 Monaten
  
   For j = 2 To UBound(sn)
      For jj = sn(j, 1) To sn(j, 2)
         sq(Val(Format(jj, "y"))) = 1
       Next
   Next
  
   For j = 2 To UBound(sp)
     sq(Val(Format(sp(j, 1), "y"))) = ""
   Next
  
   For j = 1 To UBound(sq)
      y = DateSerial(2016, 1, j)
      If Weekday(y, 2) < 6 And sq(j) <> "" Then st(Month(y), 0) = st(Month(y), 0) + 1
   Next
  
   Cells(1, 10).Resize(12) = st
End Sub

[snb]

Kann einfacher:

Code:

Sub M_snb()
   sn = Cells(1).CurrentRegion
   sp = Cells(7, 1).CurrentRegion
   ReDim st(12, 0)
 
   For j = 2 To UBound(sn)
      For jj = sn(j, 1) To sn(j, 2)
         st(Month(jj), 0) = st(Month(jj), 0) + (Weekday(jj, 2) < 6) * IsError(Application.Match(jj, sp, 0))
       Next
   Next
   
   Cells(1, 10).Resize(12) = st
End Sub

[snb]

Gibt's noch etwas neues ?

[schauan]

Hallöchen snb,

beide Codes bringen mit den Daten hier aus dem Beispiel in J2 für den Januar 13 und in J5 für den April 2. Im Februar und März wird leider nix ausgegeben.

[snb]

Das Makro setzt voraus dass A2:B5 und A8:A10 nur Daten (keine Text) enthalten.

Meine Datei enthällt NL-Daten.
Du muss sie umwandeln in DE-Daten bevor das Makro laufen zu lassen.

Die ausgeblendete Zeile 'debug.print..' ist zum 'checken' das Ergebnis.