Weken splitsen over maanden heen

[Dijaken]

Beste,

Ik zou in excel het volgende moeten kunnen produceren:

JANUARI 201152_1
JANUARI 201201_7
JANUARI 201202_7
JANUARI 201203_7
JANUARI 201204_7
JANUARI 201205_2
FEBRUARI 201205_5
FEBRUARI 201206_7
FEBRUARI 201207_7
FEBRUARI 201208_7
FEBRUARI 201209_3
MAART 201209_4
MAART 201210_7
MAART 201211_7
MAART 201212_7
MAART 201213_6
APRIL 201213_1
APRIL 201214_7

hierbij zie je van de week hoeveel dagen er in de desbetreffende maand liggen.
Ik zou dit in vba code willen omdat gebruikers een kwartaal opgeven en dit er uit zou moeten rollen.

mvg,

Dirk

 

[rebmog]

Hierbij een bestand die volgens mij doet wat jij vraagt. Ik heb de code overigens niet uitgebreid getest.

Rebmog

 

[snb]

of:

Sub M_snb()
    Cells(1, 10).Resize(19).ClearContents
    sn = Cells(1, 10).Resize(19)
    
    jj = 1
    c00 = DateSerial(Cells(2, 5), 3 * (Cells(2, 6) - 1) + 1, 1) - Weekday(DateSerial(Cells(2, 5), 3 * (Cells(2, 6) - 1) + 1, 1), 2) + 1
    For j = 1 To 14
        c01 = c00 + 6
        If Month(c00) = Month(c01) Then
           sn(jj, 1) = MonthName(Month(c00)) & "_" & Year(c00) & Format(DatePart("ww", c00, 2, 2), "00") & "_" & 7
        Else
           sn(jj, 1) = MonthName(Month(c00)) & "_" & Year(c00) & Format(DatePart("ww", c00, 2, 2), "00") & "_" & 7 - Day(c01)
            If Year(c00) = Year(c01) And j > 1 Then jj = jj + 1
           sn(jj, 1) = MonthName(Month(c01)) & "_" & Year(c00) & Format(DatePart("ww", c01, 2, 2), "00") & "_" & Day(c01)
        End If
        jj = jj + 1
        c00 = c00 + 7
    Next
    Cells(1, 10).Resize(19) = sn
End Sub

 

[sylvester-ponte]

misschien zo iets?

 

[Dijaken]

Bedankt iedereen, jullie hebben me goed geholpen!!!!!!!!
Prettig pinksterweekend.

 

[snb]

Kon nog wel wat verbeterd worden:

Sub M_snb_002()
    Cells(1).Resize(19).ClearContents
    sn = Cells(1).Resize(19)
    
    jj = 1
    c00 = DateSerial(Cells(2, 5), 3 * (Cells(2, 6) - 1) + 1, 1) - Weekday(DateSerial(Cells(2, 5), 3 * (Cells(2, 6) - 1) + 1, 1), 2) + 1
    For j = 1 To 14
        c01 = c00 + 6
        
        sn(jj, 1) = Format(c00, "mmmmyyyy") & Format(DatePart("ww", c00, 2, 2), "00") & "_" & 7 - Abs(Month(c00) <> Month(c01)) * Day(c01)
        If Month(c00) <> Month(c01) Then sn(jj + 1, 1) = Format(c01, "mmmmyyyy") & Format(DatePart("ww", c01, 2, 2), "00") & "_" & Day(c01)
        jj = jj + 1 + Abs(Month(c00) <> Month(c01))
        
        c00 = c00 + 7
    Next
    Cells(1).Resize(19) = sn
End Sub

 

[sylvester-ponte]

in mijn functie zat een fout
dit is de verbeterde :




ps Rebmog ik heb jouw sub getest: de eerste week in het jaar gaat het niet helemaal goed.