Цветовое кодирование ячеек по значению через столбец с определенным заголовком

У меня есть этот код в vba, который определяет массивы для заголовков столбцов, которые я хочу скопировать / вставить в другую вкладку в Excel. Однако на одной из новых вкладок я также хочу раскрасить некоторые ячейки в соответствии с их значением в столбце "ТИП ПРОЦЕССА ВОМ (A, U, R, D)", который соответствует позиции 2 в этом массиве. Код работает без ошибок, но ячейки вообще не меняют цвет. Пропустив некоторые части, это то, что у меня есть, кто-нибудь знает, как это исправить?

"Мои переменные.

Dim i As Long, rngCell As Range, rCell As Range
Dim c As Long, v As Long, vMHDRs As Variant, vBHDRs As Variant
Dim s As Long, vNWSs As Variant, wsMM As Worksheet

vBHDRs = Array("BOM LEVEL", "BOM PROCESS TYPE (A, U, R, D)", "ALTERNATIVE ITEM: GROUP")

Пропуск большей части кода и переход к разделу цветовой кодировки:

With Sheets("BOM")
v = 2
Set rngCell = Sheets("BOM").UsedRange.Find(What:=vBHDRs(v), LookAt:=xlWhole)   
If Not rngCell Is Nothing Then        
Set rngCell = Intersect(Sheets("BOM").UsedRange, rngCell.EntireColumn)
    For Each rCell In rngCell
    If rCell.Value = "D" Then rCell.Interior.ColorIndex = 3
    If rCell.Value = "R" Then rCell.Interior.ColorIndex = 6
    If rCell.Value = "U" Then rCell.Interior.ColorIndex = 6
    Next
End If
End With

Какие-нибудь мысли?

Источник

3 ответа

Решение

Я только что смоделировал ваш код раскраски и заставил его работать. Я считаю, что ваша проблема в строке v=2 Это из-за того, как вы выделили свой массив и настройки Excel по умолчанию. Нижняя граница для массива при выделении с использованием указанного выше метода равна 0, так что это означает, что v=2 ссылается на столбец "ALTERNATIVE ITEM: GROUP" и поэтому не находит D,R или U в этом столбце. Вы можете либо изменить значение на V=1 (и это работает), либо установить базовую опцию 1 в верхней части вашего модуля, так как это изменит нижнюю границу по умолчанию на 1. Я на самом деле советую использовать базовую опцию 1, если у вас несколько модулей, как если бы вы забыли поставить опцию базы 1 на вершине всех из них, вы можете получить неожиданные результаты. Как упоминалось выше, вам не нужны листы ("спецификации") внутри блока With, но это не влияет на его работу. Это очень немного исправленный код, который работает для меня

Sub test2()
Dim i As Long, rngCell As Range, rCell As Range
Dim c As Long, v As Long, vMHDRs As Variant, vBHDRs As Variant
Dim s As Long, vNWSs As Variant, wsMM As Worksheet
vBHDRs = Array("BOM LEVEL", "BOM PROCESS TYPE (A, U, R, D)", "ALTERNATIVE ITEM: GROUP")
With Sheets("BOM")
    v = 1
    Set rngCell = Sheets("BOM").UsedRange.Find(What:=vBHDRs(v), LookAt:=xlWhole)
    If Not rngCell Is Nothing Then
    Set rngCell = Intersect(Sheets("BOM").UsedRange, rngCell.EntireColumn)
        For Each rCell In rngCell
        If rCell.Value = "D" Then rCell.Interior.ColorIndex = 3
        If rCell.Value = "R" Then rCell.Interior.ColorIndex = 6
        If rCell.Value = "U" Then rCell.Interior.ColorIndex = 6
        Next
    End If
End With
End Sub
Источник

Когда вы используете конструкцию With, вы не должны использовать Sheets("BOM"), не так ли?

Set rngCell = .UsedRange.Find(What:=vBHDRs(v), LookAt:=xlWhole)
Источник

Если ваши целевые листы и логика окраски ячеек последовательны, то вы не можете достичь желаемой цели, используя условное форматирование в ячейках целевых листов. Тогда все, что нужно вашему макросу, - это копирование.

Источник
Другие вопросы по тегам