Разделение строк с разным содержимым «зеброй»
4059
Что умеет Excel
Допустим у Вас есть бо-о-ольшая таблица с данными. В одном столбце таблицы находятся данные по артикулам. В остальных имеется остальные данные по ним — операции, дата/время, сумма товара и т.д. Просматривать такую таблицу глазами неудобно: каждый раз приходится сверяться — а в той ли строке я смотрю? Да и разбить данные на отдельные блоки по идентичным артикулам не мешало бы. Но как? Как разбить не подскажу, а вот раскрасить можно. Один артикул в один цвет, другой в другой. И так по очереди — то один, то другой. Зебра, одним словом. Чтоб было понятней см. рис.1.
рис.1
Для этого надо всего лишь создать стандартный модуль и вставить в него следующий код:
Sub Zebra() Dim li As Long, lColor As Long, lColNum As Long, lColEND As Long lColor = xlNone On Error Resume Next lColNum = InputBox("Укажите номер столбца со значениями", "Окно ввода параметра", 1) If lColNum = 0 Then Exit Sub If Not IsNumeric(lColNum) Then Exit Sub On Error GoTo 0 lColEND = Cells(1, Columns.Count).End(xlToLeft).Column Application.ScreenUpdating = False For li = 2 To Cells(Rows.Count, lColNum).End(xlUp).Row If Cells(li, lColNum) <> Cells(li - 1, lColNum) Then If lColor = xlNone Then lColor = vbGreen Else lColor = xlNone End If Range(Cells(li, 1), Cells(li, lColEND)).Interior.Color = lColor Next li Application.ScreenUpdating = True End Sub
Sub Zebra()
Dim li As Long, lColor As Long, lColNum As Long, lColEND As Long
lColor = xlNone
On Error Resume Next
lColNum = InputBox("Укажите номер столбца со значениями", "Окно ввода параметра", 1)
If lColNum = 0 Then Exit Sub
If Not IsNumeric(lColNum) Then Exit Sub
On Error GoTo 0
lColEND = Cells(1, Columns.Count).End(xlToLeft).Column
Application.ScreenUpdating = False
For li = 2 To Cells(Rows.Count, lColNum).End(xlUp).Row
If Cells(li, lColNum) <> Cells(li - 1, lColNum) Then
If lColor = xlNone Then lColor = vbGreen Else lColor = xlNone
End If
Range(Cells(li, 1), Cells(li, lColEND)).Interior.Color = lColor
Next li
Application.ScreenUpdating = True
End SubПосле вставки просто нажмите Alt+F8 и выполните макрос Zebra.
Tips_Macro_Zebra.xls (37,0 KiB, 1 030 скачиваний)
Так же см.:
→Выделение строк цветом через одну
→Координатное выделение строки и столбца
Добрый день. Полезный макрос. Но он правильно работает есль диапазон данных начинается с первой строки первого столбца. А если, к примеру, с 3-ей, с 5-ой ……. Интересно как выглядел бы скрипт если бы «зебре» «скармливать» выделенный диапазон?
В этой строке
For li = 2 To Cells(Rows.Count, lColNum).End(xlUp).Row
меняете 2 на нужный номер строки.
Для выделенного диапазона:
For li = Selection.row To Selection.Rows.Count
А еще надо в скрипте менять?
В смысле кроме этого, надо ли что-то еще менять?
Нет. А вообще для того, чтобы понять нужно ли что-то еще менять, можно просто заменить указанное, попробовать запустить код и посмотреть результат.