Допустим есть бо-о-ольшая таблица с данными. В одном столбце этой таблицы записаны названия артикулов. В остальных столбцах вся остальная информация - операции, дата/время, сумма товара и т.п. Операций по одному артикулу может быть несколько и анализировать данные в разрезе одного артикула в такой таблице не очень удобно, т.к велика вероятность ошибки. Можно при помощи кодов и надстроек разбить данные на разные листы(к примеру, это умеет MulTEx - Разнесение данных), а можно изменить цвет ячеек так, чтобы один артикул был окрашен в один цвет, другой в другой. И так по очереди - то один, то другой. Зебра, одним словом:
Пример таблицы

Чтобы сделать такую закраску необходимо прибегнуть к помощи макросов(Что такое макрос и где его искать?): добавить в книгу стандартный модуль и вставить в него следующий код:

Sub Zebra()
    Dim li As Long, lColor As Long, lColNum As Long, lColEND As Long
    lColor = xlNone
    On Error Resume Next
    lColNum = InputBox("Укажите номер столбца со значениями", "www.excel-vba.ru", 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 и нажать Выполнить.

Приведенный код просматривает строки от 2-ой и до последней заполненной в указанном столбце. Если данные расположены начиная с другой строки(скажем, с 5-ой), то необходимо изменить цифру 2 в этой строке:
For li = 2 To Cells(Rows.Count, lColNum).End(xlUp).Row
на нужную:
For li = 5 To Cells(Rows.Count, lColNum).End(xlUp).Row
Последнюю заполненную ячейку в столбце код определяет сам.

Так же, если шапка таблицы расположена не в первой строке(как в примере, а в другой - например в 3-ей), то для корректного определения всех данных таблицы необходимо будет так же изменить еще одну строку:
lColEND = Cells(1, Columns.Count).End(xlToLeft).Column
на такую:
lColEND = Cells(3, Columns.Count).End(xlToLeft).Column

Если нужен цвет, отличный от зеленого, то надо во всем коде заменить vbGreen на любую числовую константу. Например, желтый будет 65535, а светло-серый - 12566463. Для разных версий Excel коды могут различаться. Чтобы было проще, можно закрасить любую ячейку в нужный цвет, выделить её и запустить код:

Sub GetCellInteriorColor()
    MsgBox "Код цвета выделенной ячейки: " & ActiveCell.Interior.Color, vbInformation, "www.excel-vba.ru"
End Sub

И тогда останется запомнить/записать этот код и вставить в вышеприведенный вместо vbGreen.

Скачать пример

  Tips_Macro_Zebra.xls (37,0 КиБ, 3 267 скачиваний)

Так же см.:
Выделение строк цветом через одну
Координатное выделение строки и столбца

Loading

15 комментариев

  1. Добрый день. Полезный макрос. Но он правильно работает есль диапазон данных начинается с первой строки первого столбца. А если, к примеру, с 3-ей, с 5-ой ....... Интересно как выглядел бы скрипт если бы "зебре" "скармливать" выделенный диапазон?

      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
    If lColNum > Selection.End(xlToRight).Column - Selection.Column + 1 Then
    MsgBox ("Указанный номер столбца больше количества выделенных столбцов")
    Exit Sub
    End If
    On Error GoTo 0
    lColNum = lColNum + Selection.Column - 1
    lColEND = Selection.End(xlToRight).Column
    Application.ScreenUpdating = False
    For li = Selection.Row To Selection.End(xlDown).Row
        If Cells(li, lColNum) <> Cells(li - 1, lColNum) Then
            If lColor = xlNone Then lColor = vbGreen Else lColor = xlNone
        End If
        Range(Cells(li, Selection.Column), Cells(li, lColEND)).Interior.Color = lColor
    Next li
    Application.ScreenUpdating = True
End Sub

      2. Дмитрий, все прекрасно работает. Спасибо!
        А можете помочь где и что поправить в коде, чтобы выделялась не вся строка, а только данные в выбранном столбце? То есть зебра должна отработать только в том столбце, который мы назначим.

          1. Супер! Спасибо!
            Теперь экспериментирую с цветами, все очень ярко выходит. Как то можно в код записать цвет зебры, например, светло-серый?

          3. Дмитрий, все работает корректно. Спасибо огромное за помощь!

  5. Дмитрий спасибо за сайт. Много у Вас полезного познала. А вот такая зебра не
    проще?

    Sub Zebra()
Dim Counter As Integer
For Counter = 1 To Selection.Rows.Count
  If Counter Mod 2 = 1 Then
    With Selection.Rows(Counter).Interior
      .Pattern = xlSolid
      .ColorIndex = 36
    End With
  End If
Next
 
End Sub

  6. magrifa, может и проще, но такая зебра:
    1. Будет работать только в версиях Excel, старше 2003.
    2. Закрашивает ячейки через одну, а не как описано в статье(в статье код отделяет цветом различие значений в строках). К тому же то, что Вы описали кодом можно сделать при помощи УФ. На сайте есть статья, описывающая как это можно сделать.

  8. Жанар, а Вы сами как думаете, можно Вам помочь? Я скачал пример, запустил - работает. В чем проблема у Вас можно только гадать(неверно указан столбец, отключены макросы, нет различных данных в столбце и т.д.)

Добавить комментарий

Этот сайт использует Akismet для борьбы со спамом. Узнайте, как обрабатываются ваши данные комментариев.