Excel VBA Макросы: Закрасить строку по условию.

Автор vicm, 31 октября 2018, 14:13

vicm

Помогите с макросом. Нужно чтоб закрашивал строку исходя из набора условий.

Если B не равно ""; если G не равно ""; если значения C и G совпадают, закрасить строку B-L в салатовый.
Если значение C меньше G в красный, а если больше в желтый.

[вложение удалено администратором]

Администратор

Макрос не делает проверку, есть ли данные в столбце B. Предполагаю, что в столбце B не будет пустых ячеек внутри данных.
Предположу, что не нужно делать проверку пустоты и в столбце G - если в столбце B есть данные, то и в G есть данные.

Макрос
Sub Макрос()

    Dim arr(), color As Long, lr As Long, i As Long
   
   
    '1. Отключения монитора, чтобы ускорить макрос.
    Application.ScreenUpdating = False
   
    '2. Копирование данных из листа в vba-массив. С vba-массивом макрос быстрее работает.
    ' Поиск последней строки по столбцу B. End не ищет в скрытых строках.
    lr = Cells(Rows.Count, "B").End(xlUp).Row
    ' Копирование данных из листа в vba-массив.
    arr() = Range("A1:G" & lr).Value
   
    '3. Закраска строк.
    ' Движение по массиву сверху вниз.
    For i = 2 To UBound(arr)
       
        '1) Если G равно "".
        If arr(i, 7) = "" Then
            ' Переход на следующую строку в массиве 'arr'.
            GoTo metka_NextRow
        End If
       
        '2) Выбор цвета.
        ' Если значения C и G совпадают, закрасить строку B-L в салатовый.
        If arr(i, 3) = arr(i, 7) Then
            color = 5296274
        ' Если значение C меньше G в красный.
        ElseIf arr(i, 3) < arr(i, 7) Then
            color = 12040422
        ' А если больше в желтый.
        Else
            color = 65535
        End If
       
        '3) Закраска.
        Rows(i).Columns("B:L").Interior.color = color
       
metka_NextRow:
    Next i
   
    '4. Включение монитора.
    Application.ScreenUpdating = True
   
End Sub
[свернуть]