Поиск и окраска

[ZlodeiDen]

Доброго времени суток!
Извиняюсь если создал тему дубликат. (подскажите где смотреть)
Видел много тем с окраской по значению но. они мне не подошли.

Собственно вопрос.
Возможно такое реализовать на VBA ?
Есть два листа с большим колл. строк(2000+) и столбцов(около 25)
Нужно сравнить каждую ячейку на Листе 1 с ячейкой на листе 2 (учитывая название столбца и строки !) и если значение < окрасить к примеру в зелёный > в красный.
Строки на листах могут находится в хаотичном порядке. где-то строк может быть больше, где-то меньше.
Ниже пример.

[VictorM]

УФ не подойдет здесь.
На другие листы не может оно ссылаться
Только тотальное сравнение каждой ячейки на листах и раскраска в зависимости от значения
посмотрите в этих темах поиск, сравнение

[Михаил С.]

УФ не подойдет здесь.

Ну почему же не подойдет, вполне можно...

[Hugo121]

Просили на VBA...
Тем более, если 2000+ строк и 25 столбцов, то УФ будет напрягать.

Option Explicit


Sub Pokrasitj()
    Dim a(), b As Range, oDict As Object, i As Long, temp As String
    Dim x As Range, y$

    With Application
        .ScreenUpdating = False

        a = Лист2.[a1].CurrentRegion.Value

        Set oDict = CreateObject("Scripting.Dictionary")
        oDict.CompareMode = vbTextCompare

        For i = 2 To UBound(a)
            temp = Application.Trim(a(i, 1))
            oDict.Item(temp) = _
            a(i, 2) & "|" & _
            a(i, 3) & "|" & _
            a(i, 4) & "|" & _
            a(i, 5) & "|" & _
            a(i, 6)
        Next

        For Each b In [a1].CurrentRegion.Columns(1).Cells
            If oDict.exists(b.Value) Then
                    For i = 1 To 5
                        Set x = b.Offset(, i)
                        y = Split(oDict.Item(b.Value), "|")(i - 1)
                        Select Case True
                        Case x.Value > Val(y): x.Interior.ColorIndex = 3
                        Case x.Value < Val(y): x.Interior.ColorIndex = 43
                        End Select
                    Next
            End If
        Next

        .ScreenUpdating = True
    End With
End Sub

temp = Application.Trim(a(i, 1)) - может быть и лишняя предосторожность, можно вместо temp сразу a(i, 1) писать, но пусть будет.

[VictorM]

Ну почему же не подойдет, вполне можно...

Да, был неправ, возьму себе на заметку.
Хотя...крайне редко применяю УФ и только на небольших объемах данных.
Потому как

если 2000+ строк и 25 столбцов, то УФ будет напрягать.

напрягает! Проверено!

[ZlodeiDen]

Всем огромное Спасибо !