VBA Макрос или условное форматирование, Задача сравнить столбцы и окрасить ячейки

  • Кидай файл на почту.
  • Две области выделяйте через Ctrl + клик. Можно выделить целые колонки.

    Sub comparison()
    ' Проверка на 2 области
    If Selection.Areas.Count <> 2 Then
    MsgBox "Выделите две области! "
    Exit Sub
    End If

    ' Проверка на равные длины областей
    If Selection.Areas(1).Cells.Count <> Selection.Areas(2).Cells.Count Then
    MsgBox "Выделенные области должны быть одной длины"
    Exit Sub
    End If

    ' Отключение пересчета формул и обновления экрана в excel
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    'Пробегаем до последней непустой ячейки
    For I = 1 To Selection.Areas(1).Cells(1, 1).End(xlDown).Row
    ' Проверяем, что в ячейках записаны числа
    If IsNumeric(Selection.Areas(1).Cells(I, 1)) And _
    IsNumeric(Selection.Areas(2).Cells(I, 1)) Then
    ' Если первое больше второго, красим в зеленый
    If Selection.Areas(1).Cells(I, 1) > Selection.Areas(2).Cells(I, 1) Then
    Selection.Areas(1).Cells(I, 1).Interior.Color = RGB(100, 255, 100)
    Selection.Areas(2).Cells(I, 1).Interior.Color = RGB(100, 255, 100)
    Else
    ' Если второе больше первого, красим в оранжевый
    If Selection.Areas(1).Cells(I, 1) < Selection.Areas(2).Cells(I, 1) Then
    Selection.Areas(1).Cells(I, 1).Interior.Color = RGB(255, 128, 0)
    Selection.Areas(2).Cells(I, 1).Interior.Color = RGB(255, 128, 0)
    Else
    ' Если равны, то не красим
    Selection.Areas(1).Cells(I, 1).Interior.ColorIndex = xlNone
    Selection.Areas(2).Cells(I, 1).Interior.ColorIndex = xlNone
    End If
    End If
    End If
    Next I

    ' Включение пересчета формул и обновления экрана
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    End Sub

Вас заинтересует