Страницы: 1
RSS
Проставить дату начала и окончания недели, согласно номера недели.....
 
Уважаемы форумчане, добрый день!
Такая задача:
в строке идут месяца, на нижней строке под месяцем идут номера недели согласно месяца, под номером недели идёт порядковая дата начала недели и порядковая дата окончания недели(к примеру: неделя "4" с 20 - 26), типо как в календаре...

Сейчас сижу в ручную, пишу), но если кто знает, может строка "4" формулой протягивается...?)
 
Тут
 
skais675, не совсем то), но по этой ссылке я нашел видимо коллегу по старой работе :D  
Изменено: eroshin1991 - 22.01.2020 18:50:00
 
eroshin1991,
Цитата
в ручную, пишу)
С ячейки А10 и вниз проставил даты с 01.01.2020 и до 31.12.2020
Затем запустил макрос
Код
Sub WeekNum()
Dim i As Long
Dim iLastRow As Long
Dim j As Integer
Dim FDay As Integer
Dim EDay As Integer
Dim LastDay As Integer
   iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
   For i = 10 To iLastRow            'проставляем номер недели в столбец В
     Cells(i, "B") = CInt(Format(Cells(i, "A"), "ww", 2))
   Next
     Rows("6:7").ClearContents
     j = 2
   For i = 10 To iLastRow
      Cells(6, j) = Cells(i, "B")    'номер недели
      FDay = Day(Cells(i, "A"))      'первый день недели
      LastDay = Day(DateSerial(Year(Cells(i, "A")), Month(Cells(i, "A")) + 1, 1) - 1)
     Do
       If Cells(i + 1, "B") <> Cells(i, "B") Then Exit Do
       i = i + 1
       If Day(Cells(i, "A")) = LastDay Then Exit Do
     Loop While Cells(i + 1, "B") = Cells(i, "B")
       EDay = Day(Cells(i, "A"))     'последний день недели
       Cells(7, j) = "c " & FDay & " - " & EDay
     If Day(Cells(i, "A")) = LastDay Then j = j + 1
       j = j + 1
   Next
End Sub
Страницы: 1
Наверх