Clever-Excel-Forum

Clever-Excel-Forum > Office-Anwendungen > Excel > Arbeitstage monatsweise aufdröseln
Normale Version: Arbeitstage monatsweise aufdröseln
Du siehst gerade eine vereinfachte Darstellung unserer Inhalte. Normale Ansicht mit richtiger Formatierung.
Seiten: 1 2

schauan

10.10.2016, 19:51
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 Sad
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  Huh

Tabellenblattname: Tabelle1
ABCDEF
1vonbisMonatTagesind wohl
204.01.201610.01.2016Januar14
312.01.201615.01.2016Februar7
425.01.201605.02.2016März21
524.02.201604.04.2016April2
6
7Feiertage
806.01.2016
925.03.2016
1028.03.2016


© schauan

shift-del

10.10.2016, 21:33
(10.10.2016, 19:51)schauan schrieb: [ -> ]Vorteilhaft wäre eine Lösung ohne Hilfsspalten.
Ob das wirklich vorteilhaft ist?
Arbeitsblatt mit dem Namen 'Tabelle1 (2)'
 ABCDEF
1vonbis MonatTagesind wohl
204.01.201610.01.2016 Januar1314
312.01.201615.01.2016 Februar97
425.01.201605.02.2016 März2121
524.02.201604.04.2016 April22
6      
7Feiertage     
806.01.2016     
925.03.2016     
1028.03.2016     

ZelleFormel
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

11.10.2016, 00:08
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

11.10.2016, 17:03
Hallöchen,

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

schauan

16.10.2016, 07:32
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

16.10.2016, 13:11
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

16.10.2016, 15:49
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

17.10.2016, 16:35
Gibt's noch etwas neues ?

schauan

22.10.2016, 05:56
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

22.10.2016, 11:22
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.
Seiten: 1 2
Clever-Excel-Forum > Office-Anwendungen > Excel > Arbeitstage monatsweise aufdröseln