Udregne arbejdsdage

Til oplysning
Jeg kender godt =ANTAL.ARBEJDSDAGE(C3;D3)
Men hvordan får jeg det delt ud på hver måned?
Mvh
Petert

Send en mail - så returnerer jeg et forslag..

(mailadr. under profil)

Rem EVT. JUSTERING VEDR.:
Rem Grundlovsdag, Juleaftensdag & Nytårsaftensdag
Rem Disse tælles IKKE med som arbejdsdage p.t.
Rem =============================================
Dim hÅr As Integer, påskeDag As Date
Dim hDageFaste As Variant, hDageVar As Variant

Dim fraDag As Date, tilDag As Date
Dim antalArbejdsDage As Integer
Private Sub CommandButton1_Click()                  'Beregn
Dim dag As Date
    ActiveWorkbook.Sheets("Indstillinger").Range("B6:B17").Select
    Selection.ClearContents
   
    fraDag = Me.TextBox1
    tilDag = Me.TextBox2
    hÅr = 0
   
    antalArbejdsDage = 0
   
    For dag = fraDag To tilDag
Rem opsætning af helligdage for året
        If hÅr = 0 Or hÅr <> Year(dag) Then
            påskeDag = beregnPåske(Year(dag))
            opsætningAfHelligDage påskeDag
            hÅr = Year(dag)
        End If
       
Rem undersøg om helligdag
        If erDetHelligdag(dag) = False Then
Rem Hvis nej - test om lør/søn
            If Weekday(dag, vbMonday) < 6 Then
Rem optæl pr. måned
                With ActiveWorkbook.Sheets("Indstillinger")
                    .Cells(Month(dag) + 5, 2) = .Cells(Month(dag) + 5, 2) + 1
                End With
               
                antalArbejdsDage = antalArbejdsDage + 1
            End If
        End If
    Next dag

    Me.Label4 = antalArbejdsDage
   
    ActiveWorkbook.Sheets("Indstillinger").Activate
   
End Sub
Public Function beregnPåske(aar)

Rem Beregning af Paaske - 1900 - 2099
Rem =================================
Dim d, E, Q
    b1 = aar Mod 19
    d = 225 - (11 * b1)
   
    If d > 50 Then
        While d > 50
            d = d - 30
        Wend
    End If
   
    If d > 48 Then
        d = d - 1
    End If
   
    E = (aar + Int(aar / 4) + d + 1) Mod 7
   
    Q = d + 7 - E
   
    If Q < 32 Then
        m = "03"
    Else
        m = "04"
        Q = Q - 31
    End If
   
    beregnPåske = CStr(Q) + "-" + m + "-" + CStr(aar)
End Function
Public Sub opsætningAfHelligDage(påskeDag)
Rem Faste

Rem Nytårsdag/(Grundlovsdag)/(Juleaften)/Juledag/2. Juledag/(Nytårsaften)
    hDageFaste = Array("01-01", "05-06", "24-12", "25-12", "26-12", "31-12")

Rem Grundlovsdag
    If Me.CheckBox1 = True Then
        hDageFaste(1) = ""
    End If
   
Rem Juleaften
    If Me.CheckBox2 = True Then
        hDageFaste(2) = ""
    End If

Rem Nytårsaften
    If Me.CheckBox3 = True Then
        hDageFaste(5) = ""
    End If

Rem Skærtorsdag/Langfredag/Påskedag/2. Påskedag/St. Bededag/Kr. Himmelfart/Pinsedag/2. Pinsedag
    hDageVar = Array("", "", "", "", "", "", "", "")

Rem Skærtorsdag
    hDageVar(0) = Format(DateAdd("d", -3, påskeDag), "dd-mm")
   
Rem Langfredag
    hDageVar(1) = Format(DateAdd("d", -2, påskeDag), "dd-mm")

Rem Påskedag
    hDageVar(2) = Format(påskeDag, "dd-mm")

Rem 2. Påskedag
    hDageVar(3) = Format(DateAdd("d", 1, påskeDag), "dd-mm")

Rem St. Bededag
    hDageVar(4) = Format(DateAdd("ww", 4, hDageVar(1)), "dd-mm")
   
Rem Kr. Himmelfart
    hDageVar(5) = Format(DateAdd("ww", 6, hDageVar(0)), "dd-mm")
   
Rem Pinsedag
    hDageVar(6) = Format(DateAdd("ww", 7, påskeDag), "dd-mm")

Rem 2. Pinsedag
    hDageVar(7) = Format(DateAdd("d", 1, hDageVar(6)), "dd-mm")
End Sub
Public Function erDetHelligdag(testDato)
Dim f, dato As String
    dato = Format(testDato, "dd-mm")

Rem Faste helligdage
    For f = 0 To 5
        If hDageFaste(f) = CStr(dato) Then
            erDetHelligdag = True
            Exit Function
        End If
    Next f

Rem Variable
    For f = 0 To 7
        If hDageVar(f) = dato Then
            erDetHelligdag = True
            Exit Function
        End If
    Next f
   
    erDetHelligdag = False
End Function
Private Sub CommandButton2_Click()                  'Luk
    gemIndstillinger
   
    Unload UserForm1
End Sub
Private Sub UserForm_activate()
    læsIndstillinger
End Sub
Private Sub læsIndstillinger()
    Me.CheckBox1 = sætCheckbox(2, 3)
    Me.CheckBox2 = sætCheckbox(3, 3)
    Me.CheckBox3 = sætCheckbox(4, 3)
End Sub
Private Function sætCheckbox(ræk, kol)
    With ActiveWorkbook.Sheets("Indstillinger")
        If .Cells(ræk, kol) = "x" Then
            sætCheckbox = True
        Else
            sætCheckbox = False
        End If
    End With
End Function
Private Sub gemIndstillinger()
    sætIndstilling 2, 3, Me.CheckBox1.Value
    sætIndstilling 3, 3, Me.CheckBox2.Value
    sætIndstilling 4, 3, Me.CheckBox1.Value
End Sub
Private Sub sætIndstilling(ræk, kol, værdi)
    With ActiveWorkbook.Sheets("Indstillinger")
        If værdi = True Then
            .Cells(ræk, kol) = "x"
        Else
            .Cells(ræk, kol) = ""
        End If
    End With
End Sub