vlookup для цветов ячеек с использованием VBA

Question

Я обыскал этот сайт (и другие) в поисках ответа, но не смог найти правильного решения после трех лет.Я не хочу использовать условное форматирование, потому что я добавляю ячейки и постоянно меняю цвета.Поэтому я ищу решение vba, но я здесь не эксперт.

У меня есть один лист с 20 различными значениями (ячейки от a1 до t1).В этом же листе я использовал vba для извлечения значений RGB каждой ячейки (от a2 до t4).На другом листе есть таблица 5000+, и в двух столбцах я выбираю одно из 20 значений (из другого wsheet) из раскрывающегося списка.Мне нужно, чтобы цвет автоматически обновлялся, чтобы он соответствовал цвету в первом листе.

У меня есть этот код, который я считаю очень примитивным, он действительно работает, но для каждого внесенного изменения требуется много времени, чтобыобновить всю книгу, и это раздражает и неэффективно.Мне нужна поддержка в улучшении этой работы.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Name1, Name2, Name3, Name4, Name5, Name6, Name7, Name8, Name9, Name10,
Name11, Name12, Name13, Name14, Name15, Name16, Name17, Name18, Name19,  
Name20 As String
Name1 = Worksheets("C").Range("Name1")
Name2 = Worksheets("C").Range("Name2")
Name3 = Worksheets("C").Range("Name3")
Name4 = Worksheets("C").Range("Name4")
Name5 = Worksheets("C").Range("Name5")
Name6 = Worksheets("C").Range("Name6")
Name7 = Worksheets("C").Range("Name7")
Name8 = Worksheets("C").Range("Name8")
Name9 = Worksheets("C").Range("Name9")
Name10 = Worksheets("C").Range("Name10")
Name11 = Worksheets("C").Range("Name11")
Name12 = Worksheets("C").Range("Name12")
Name13 = Worksheets("C").Range("Name13")
Name14 = Worksheets("C").Range("Name14")
Name15 = Worksheets("C").Range("Name15")
Name16 = Worksheets("C").Range("Name16")
Name17 = Worksheets("C").Range("Name17")
Name18 = Worksheets("C").Range("Name18")
Name19 = Worksheets("C").Range("Name19")
Name20 = Worksheets("C").Range("Name20")

Dim Red1, Green1, Blue1, Red2, Green2, Blue2, Red3, Green3, Blue3, Red4, 
Green4, Blue4, Red5, Green5, Blue5, Red6, Green6, Blue6, Red7, Green7, 
Blue7, Red8, Green8, Blue8, Red9, Green9, Blue9, Red10, Green10, Blue10, 
Red11, Green11, Blue11, Red12, Green12, Blue12, Red13, Green13, Blue13, 
Red14, Green14, Blue14, Red15, Green15, Blue15, Red16, Green16, Blue16, 
Red17, Green17, Blue17, Red18, Green18, Blue18, Red19, Green19, Blue19, 
Red20, Green20, Blue20 As Integer
Red1 = Worksheets("C").Range("Rojo1")
Green1 = Worksheets("C").Range("Verde1")
Blue1 = Worksheets("C").Range("Azul1")
Red2 = Worksheets("C").Range("Rojo2")
Green2 = Worksheets("C").Range("Verde2")
Blue2 = Worksheets("C").Range("Azul2")
Red3 = Worksheets("C").Range("Rojo3")
Green3 = Worksheets("C").Range("Verde3")
Blue3 = Worksheets("C").Range("Azul3")
Red4 = Worksheets("C").Range("Rojo4")
Green4 = Worksheets("C").Range("Verde4")
Blue4 = Worksheets("C").Range("Azul4")
Red5 = Worksheets("C").Range("Rojo5")
Green5 = Worksheets("C").Range("Verde5")
Blue5 = Worksheets("C").Range("Azul5")
Red6 = Worksheets("C").Range("Rojo6")
Green6 = Worksheets("C").Range("Verde6")
Blue6 = Worksheets("C").Range("Azul6")
Red7 = Worksheets("C").Range("Rojo7")
Green7 = Worksheets("C").Range("Verde7")
Blue7 = Worksheets("C").Range("Azul7")
Red8 = Worksheets("C").Range("Rojo8")
Green8 = Worksheets("C").Range("Verde8")
Blue8 = Worksheets("C").Range("Azul8")
Red9 = Worksheets("C").Range("Rojo9")
Green9 = Worksheets("C").Range("Verde9")
Blue9 = Worksheets("C").Range("Azul9")
Red10 = Worksheets("C").Range("Rojo10")
Green10 = Worksheets("C").Range("Verde10")
Blue10 = Worksheets("C").Range("Azul10")
Red11 = Worksheets("C").Range("Rojo11")
Green11 = Worksheets("C").Range("Verde11")
Blue11 = Worksheets("C").Range("Azul11")
Red12 = Worksheets("C").Range("Rojo12")
Green12 = Worksheets("C").Range("Verde12")
Blue12 = Worksheets("C").Range("Azul12")
Red13 = Worksheets("C").Range("Rojo13")
Green13 = Worksheets("C").Range("Verde13")
Blue13 = Worksheets("C").Range("Azul13")
Red14 = Worksheets("C").Range("Rojo14")
Green14 = Worksheets("C").Range("Verde14")
Blue14 = Worksheets("C").Range("Azul14")
Red15 = Worksheets("C").Range("Rojo15")
Green15 = Worksheets("C").Range("Verde15")
Blue15 = Worksheets("C").Range("Azul15")
Red16 = Worksheets("C").Range("Rojo16")
Green16 = Worksheets("C").Range("Verde16")
Blue16 = Worksheets("C").Range("Azul16")
Red17 = Worksheets("C").Range("Rojo17")
Green17 = Worksheets("C").Range("Verde17")
Blue17 = Worksheets("C").Range("Azul17")
Red18 = Worksheets("C").Range("Rojo18")
Green18 = Worksheets("C").Range("Verde18")
Blue18 = Worksheets("C").Range("Azul18")
Red19 = Worksheets("C").Range("Rojo19")
Green19 = Worksheets("C").Range("Verde19")
Blue19 = Worksheets("C").Range("Azul19")
Red20 = Worksheets("C").Range("Rojo20")
Green20 = Worksheets("C").Range("Verde20")
Blue20 = Worksheets("C").Range("Azul20")

For Each cell In Range("b4:o23") 'change cell range as needed

Select Case cell.Value
Case Name1
cell.Interior.Color = RGB(Red1, Green1, Blue1)
Case Name2
cell.Interior.Color = RGB(Red2, Green2, Blue2)
Case Name3
cell.Interior.Color = RGB(Red3, Green3, Blue3)
Case Name4
cell.Interior.Color = RGB(Red4, Green4, Blue4)
Case Name5
cell.Interior.Color = RGB(Red5, Green5, Blue5)
Case Name6
cell.Interior.Color = RGB(Red6, Green6, Blue6)
Case Name7
cell.Interior.Color = RGB(Red7, Green7, Blue7)
Case Name8
cell.Interior.Color = RGB(Red8, Green8, Blue8)
Case Name9
cell.Interior.Color = RGB(Red9, Green9, Blue9)
Case Name10
cell.Interior.Color = RGB(Red10, Green10, Blue10)
Case Name11
cell.Interior.Color = RGB(Red11, Green11, Blue11)
Case Name12
cell.Interior.Color = RGB(Red12, Green12, Blue12)
Case Name13
cell.Interior.Color = RGB(Red13, Green13, Blue13)
Case Name14
cell.Interior.Color = RGB(Red14, Green14, Blue14)
Case Name15
cell.Interior.Color = RGB(Red15, Green15, Blue15)
Case Name16
cell.Interior.Color = RGB(Red16, Green16, Blue16)
Case Name17
cell.Interior.Color = RGB(Red17, Green17, Blue17)
Case Name18
cell.Interior.Color = RGB(Red18, Green18, Blue18)
Case Name19
cell.Interior.Color = RGB(Red19, Green19, Blue19)
Case Name20
cell.Interior.Color = RGB(Red20, Green20, Blue20)
Case Else
cell.Interior.ColorIndex = 0
End Select

Next cell

End Sub

Answer 1

Вы можете сделать это:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rngLookup As Range, rng As Range, m, c As Range

    Set rngLookup = Sheets("C").Range("A1:T1")
    Set rng = Application.Intersect(Target, Me.Range("B4:O23"))
    If Not rng Is Nothing Then
        For Each c In rng.Cells
            m = Application.Match(c.Value, rngLookup, 0)
            If Not IsError(m) Then
                c.Interior.Color = rngLookup.Cells(m).Interior.Color
            Else
                c.Interior.ColorIndex = 0
            End If
        Next c
    End If

End Sub

Примечание - упростил это далее, просто извлекая «ключевой» цвет ячейки напрямую (не нужно извлекать и сохранять отдельные значения R, G и B)