Страницы: 1
RSS
Ошибка макроса при вычислении дат
 
Доброго времени, нашел на просторах инета функцию поиска понедельников месяца и переделал под свои нужды - понедельный поиск понедельника и воскресенья, а при условии начала месяца не с понедельника, то неделя начинается с 1 числа месяца. аналогично и воскресенье и последний день месяца.
ПРОБЛЕМА - вылетает ошибка при работе с январем и декабрем, почему не понял.
Инженер не тот, кто все знает, а тот кто знает где найти ответ.
 
используйте это:
Код
Function Pnd(dt As Date)
  Dim d1 As Date, d2 As Date
  d1 = DateSerial(Year(dt), Month(dt), 1)
  Do While Month(dt) = Month(d1)
    If Month(d1 - Weekday(d1, 2) + 7) <> Month(dt) Then d2 = WorksheetFunction.EoMonth(d1, 0) Else d2 = d1 - Weekday(d1, 2) + 7
    MsgBox d1 & "   " & d2 & "   " & d2 + 1 - d1: d1 = d2 + 1
  Loop
End Function
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Код
Sub asd()
    m = CDate(InputBox("Date"))
    
    ReDim arr(0 To 1, 0 To 1)
    
    i = 0
    For d = DateSerial(Year(m), Month(m), 1) To DateSerial(Year(m), Month(m) + 1, 0)
        If Weekday(d, 2) = 1 Then
            arr(0, i) = d
        ElseIf Weekday(d, 2) = 7 Then
            arr(1, i) = d
            If arr(1, i) <> DateSerial(Year(m), Month(m) + 1, 0) Then
                i = i + 1
                ReDim Preserve arr(1, i)
            End If
        End If
    Next
    
    If IsEmpty(arr(0, 0)) Then
        arr(0, 0) = DateSerial(Year(m), Month(m), 1)
    End If
    
    If IsEmpty(arr(1, i)) Then
        arr(1, i) = DateSerial(Year(m), Month(m) + 1, 0)
    End If
    
    
    Cells(1, 1).Resize(UBound(arr, 2) + 1, 2) = Application.Transpose(arr)
End Sub
 
спс за варианты, после доработок из любого смогу получить нужный далее результат, но в чем была ошибка в моем варианте, почему именно январь и декабрь?
Инженер не тот, кто все знает, а тот кто знает где найти ответ.
Страницы: 1
Наверх