Sub ConcatMonth()
Dim iBeginDate As Date
Dim iEndDate As Date
Dim j As Long
Dim jLastColumn As Long
iBeginDate = Range("B3")
If Day(iBeginDate) <> 1 Then
MsgBox "В ячейке В3 не начальная дата месяца"
Exit Sub
End If
jLastColumn = Cells(3, Columns.Count).End(xlToLeft).Column
Rows("1:2").UnMerge
Rows("1:2").ClearContents
Rows("1:2").NumberFormat = "@"
iEndDate = DateSerial(Year(iBeginDate), Month(iBeginDate) + 1, 1) - 1
For j = 2 To jLastColumn
Select Case Month(iEndDate)
Case 1, 3, 5, 7, 8, 10, 12
Range(Cells(2, j + 20), Cells(2, j + Day(iEndDate) - 1)).MergeCells = True
Range(Cells(2, j + 20), Cells(2, j + Day(iEndDate) - 1)) = "21-31"
Case 4, 6, 9, 11
Range(Cells(2, j + 20), Cells(2, j + Day(iEndDate) - 1)).MergeCells = True
Range(Cells(2, j + 20), Cells(2, j + Day(iEndDate) - 1)) = "21-30"
Case 2
Range(Cells(2, j + 20), Cells(2, j + Day(iEndDate) - 1)).MergeCells = True
If Day(iEndDate) = 28 Then
Range(Cells(2, j + 20), Cells(2, j + Day(iEndDate) - 1)) = "21-28"
Else
Range(Cells(2, j + 20), Cells(2, j + Day(iEndDate) - 1)) = "21-29"
End If
End Select
Range(Cells(2, j), Cells(2, j + 9)).MergeCells = True
Range(Cells(2, j), Cells(2, j + 9)) = "01-10"
Range(Cells(2, j + 10), Cells(2, j + 19)).MergeCells = True
Range(Cells(2, j + 10), Cells(2, j + 19)) = "11-20"
Range(Cells(1, j), Cells(1, j + Day(iEndDate) - 1)).MergeCells = True
Range(Cells(1, j), Cells(1, j + Day(iEndDate) - 1)) = Format(Cells(3, j), "MMMM YYYY")
j = j + Day(iEndDate) - 1
iEndDate = DateSerial(Year(iEndDate), Month(iEndDate) + 2, 1) - 1
Next
End Sub
|