Как узнать общее количество дней за месяц - PullRequest
Новая
       5

Как узнать общее количество дней за месяц

4 голосов
/ 03 января 2012

Я хочу найти общее количество дней в месяц по дням.

Например

Месяц '01/2011' (мм / гггг) 

Expected Output

Sunday - 5
Monday - 5
Tuesday - 5
Wednesday - 4
Thursday - 4
Friday - 4
Saturday - 4

Пробный код 

Dim lngCnt As Long
    Dim strOut As String
    dtStart = DateValue('01/2012')
    dtEnd = DateAdd("d", DateDiff("d", '01/2012', DateAdd("m", 1, '01/2012') - 1), dtStart)
    lngCnt = Weekday(dtStart) - 3
    Do
        lngCnt = lngCnt + 3
        strOut = strOut & Format(lngCnt, "00") & ","
    Loop While lngCnt + 3 <= dtEnd - dtStart

Приведенный выше код даст результат как Wednesday = 4, 11, 18, 25

Но я хочу общее количество wednesday = 4 ', как это

Как выполнить в vb6

Нужна помощь по коду VB6

Ответы [ 2 ]

3 голосов
/ 03 января 2012

Вот функция, которую вы можете вызвать

Он принимает два параметра (год и месяц) и возвращает массив (от 1 до 7), представляющий количество дней с месяца по воскресенье по субботу 

Function Days(yr As Long, mn As Long) As Variant
    Dim First As Date
    Dim FirstDay As Long
    Dim DaysInMonth As Long
    Dim DayCount(1 To 7) As Long
    Dim i As Long

    DayCount(1) = 4
    DayCount(2) = 4
    DayCount(3) = 4
    DayCount(4) = 4
    DayCount(5) = 4
    DayCount(6) = 4
    DayCount(7) = 4

    First = DateSerial(yr, mn, 1)
    DaysInMonth = DateSerial(yr, mn + 1, 1) - First
    FirstDay = Weekday(First)
    For i = FirstDay To DaysInMonth + FirstDay - 28 - 1
        DayCount((i - 1) Mod 7 + 1) = 5
    Next

    Days = DayCount
End Function

UPDATE:

, чтобы использовать это для получения числа пятниц в месяце, используйте 

Fridays = Days(2012, 2)(6)  ' For Fridays in Fedruary 2012

Обновление 2:

Принимая советы Бреттджа

Чтобы вернуть строку типа «Пятницы = 4», используйте 

Array("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday")(6) & " = " & Days(2012, 2)(6)
2 голосов
/ 03 января 2012

Обновленный ответ Обновлен для вашего комментария, чтобы возвращать либо

  1. Дней в месяце только на один день (Нажмите Yes в приглашении Msgbox), либо

  2. Дни в месяце для каждого дня недели (Нажмите No в приглашении Msgbox). 

    Sub GetDay()  
Dim strMonth As String  
Dim strOut As String  
Dim lngDay As Long  
Dim lngCheck As Long  

strMonth = "01/2012"

lngCheck = MsgBox("Press Yes to run single day" & vbNewLine & "Press No to run the entire week", vbYesNoCancel, "User choice")

If lngCheck = vbCancel Then Exit Sub

If lngCheck = vbYes Then
'Option 1 one day
lngDay = vbFriday
strOut = strOut & DaysInMonth(lngDay, strMonth) & vbNewLine
Else
'Option 2 all days
For lngDay = vbSunday To vbSaturday
strOut = strOut & DaysInMonth(lngDay, strMonth) & vbNewLine
Next
End If

MsgBox strOut
End Sub

Function DaysInMonth(ByVal lngDay, ByVal strMonth)
Dim dtStart As Date
Dim dtEnd As Date
Dim dtTest As Date
Dim lngCnt As Long
Dim i As Long

dtStart = DateValue(strMonth)
dtEnd = DateAdd("d", DateDiff("d", strMonth, DateAdd("m", 1, strMonth) - 1), dtStart)
lngCnt = (dtEnd - dtStart + 1)

DaysInMonth = WeekdayName(lngDay, , vbSunday) & " - 4"

For i = 1 To lngCnt Mod 7
If Weekday(DateAdd("d", i - 1, dtStart)) = lngDay Then
 DaysInMonth = WeekdayName(lngDay, , vbSunday) & " - 5"
Exit For
End If
Next

End Function
...