Lost your password?


Хитрости »
Основные понятия (27)
Сводные таблицы и анализ данных (10)
Графики и диаграммы (5)
Работа с VB проектом (12)
Power BI и Power Query (23)
Условное форматирование (5)
Списки и диапазоны (5)
Макросы(VBA процедуры) (68)
Разное (43)
Баги и глюки Excel (5)

Разделение строк с разным содержимым "зеброй"

Допустим есть бо-о-ольшая таблица с данными. В одном столбце этой таблицы записаны названия артикулов. В остальных столбцах вся остальная информация - операции, дата/время, сумма товара и т.п. Операций по одному артикулу может быть несколько и анализировать данные в разрезе одного артикула в такой таблице не очень удобно, т.к велика вероятность ошибки. Можно при помощи кодов и надстроек разбить данные на разные листы(к примеру, это умеет 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 KiB, 3 231 скачиваний)

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


Статья помогла? Поделись ссылкой с друзьями!
  Плейлист   Видеоуроки

Поиск по меткам

Access apple watch Multex Power Query и Power BI VBA управление кодами Бесплатные надстройки Дата и время Записки ИП Надстройки Печать Политика Конфиденциальности Почта Программы Работа с приложениями Разработка приложений Росстат Тренинги и вебинары Финансовые Форматирование Функции Excel акции MulTEx ссылки статистика
Обсуждение: 15 комментариев
  1. Юрий:

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

    • В этой строке
      For li = 2 To Cells(Rows.Count, lColNum).End(xlUp).Row
      меняете 2 на нужный номер строки.

      Для выделенного диапазона:
      For li = Selection.row To Selection.Rows.Count

      • Ivan.kh:

        Могу ошибаться, но для выделенного диапазона, код должен выглядеть как-то так:

        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
      • Татьяна:

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

        • Татьяна, для этого надо эту строку:
          Range(Cells(li, 1), Cells(li, lColEND)).Interior.Color = lColor
          записать так:
          Cells(li, lColNum).Interior.Color = lColor

          • Татьяна:

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

          • Татьяна, добавил в конце статьи небольшую инструкцию на этот счет.

          • Татьяна:

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

  2. Юрий:

    А еще надо в скрипте менять?

  3. Юрий:

    В смысле кроме этого, надо ли что-то еще менять?

  4. Нет. А вообще для того, чтобы понять нужно ли что-то еще менять, можно просто заменить указанное, попробовать запустить код и посмотреть результат.

  5. magrifa:

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

    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. Закрашивает ячейки через одну, а не как описано в статье(в статье код отделяет цветом различие значений в строках). К тому же то, что Вы описали кодом можно сделать при помощи УФ. На сайте есть статья, описывающая как это можно сделать.

  7. Жанар:

    не сработал пример, почему?
    я что то не так сделала?
    Просто скопировала и запустила.
    Что не так то?

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

Поделитесь своим мнением

Комментарии, не имеющие отношения к комментируемой статье, могут быть удалены без уведомления и объяснения причин. Если есть вопрос по личной проблеме - добро пожаловать на Форум


Для оформления сообщений Вы можете использовать следующие тэги:
<a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong>

Тренинги

Заказать
Юридическая информация

Использование материалов сайта

Политика Конфиденциальности

ИП Щербаков Дмитрий Валентинович
ОГРНИП: 318502700083307
ИНН: 504013350772

Наши партнеры

Перейти

Счетчики

Рейтинг@Mail.ru Яндекс.Метрика
© 2024 Excel для всех   Войти