Sub Макрос() Dim i As Long, n As Long For i = 2 To Range("C" & Rows.Count).End(xlUp).Row If Cells(i, 3) = "" Or Cells(i, 3) = "Месяц" Then n = IIf(Cells(i + 1, 3).End(xlDown).Row = Rows.Count, i + 1, Cells(i + 1, 3).End(xlDown).Row) Range(Cells(i + 1, 3), Cells(n, 3)).Rows.Group End If Next i End Sub
[/vba]
Можно единицы не ставить[vba]
Код
Sub Макрос() Dim i As Long, n As Long For i = 2 To Range("C" & Rows.Count).End(xlUp).Row If Cells(i, 3) = "" Or Cells(i, 3) = "Месяц" Then n = IIf(Cells(i + 1, 3).End(xlDown).Row = Rows.Count, i + 1, Cells(i + 1, 3).End(xlDown).Row) Range(Cells(i + 1, 3), Cells(n, 3)).Rows.Group End If Next i End Sub
А можно этот макрос модифицировать чтобы не ставить маркеры, а аналогично группировать непустые ячейки в колонке "С", а группировка была сверху группы?
А можно этот макрос модифицировать чтобы не ставить маркеры, а аналогично группировать непустые ячейки в колонке "С", а группировка была сверху группы?pabchek
"Учиться, учиться и еще раз учиться!" WM: R399923528092
Sub Макрос() Dim i As Long, n As Long For i = 2 To Range("C" & Rows.Count).End(xlUp).Row If Cells(i, 3) = "" Then n = IIf(Cells(i + 1, 3).End(xlDown).Row = Rows.Count, i + 1, Cells(i + 1, 3).End(xlDown).Row) Range(Cells(i + 1, 3), Cells(n, 3)).Rows.Group End If Next i End Sub
[/vba]
Жуткие изменения кода [vba]
Код
Sub Макрос() Dim i As Long, n As Long For i = 2 To Range("C" & Rows.Count).End(xlUp).Row If Cells(i, 3) = "" Then n = IIf(Cells(i + 1, 3).End(xlDown).Row = Rows.Count, i + 1, Cells(i + 1, 3).End(xlDown).Row) Range(Cells(i + 1, 3), Cells(n, 3)).Rows.Group End If Next i End Sub
Sub Макрос() Dim i As Long, n As Long For i = 2 To Range("A" & Rows.Count).End(xlUp).Row If Cells(i, 1) = "" Then n = IIf(Cells(i + 1, 1).End(xlDown).Row = Rows.Count, i + 1, Cells(i + 1, 1).End(xlDown).Row) Range(Cells(i + 1, 1), Cells(n, 1)).Rows.Group End If Next i End Sub
[/vba]
Тогда так [vba]
Код
Sub Макрос() Dim i As Long, n As Long For i = 2 To Range("A" & Rows.Count).End(xlUp).Row If Cells(i, 1) = "" Then n = IIf(Cells(i + 1, 1).End(xlDown).Row = Rows.Count, i + 1, Cells(i + 1, 1).End(xlDown).Row) Range(Cells(i + 1, 1), Cells(n, 1)).Rows.Group End If Next i End Sub