我一直在这个站点（和其他站点）周围寻找答案，但是三年之后，我一直无法找到正确的解决方案。我不想使用条件格式，因为我要添加单元格并不断更改颜色。因此，我正在寻找vba解决方案，但我不是这里的专家。
我有一个包含20个不同值的工作表（单元格a1至t1）。在同一工作表中，我使用vba提取每个单元（a2至t4）的RGB值。在另一个工作表中，有一个5000+的表，在两个列中，我从下拉列表中选择20个值之一（从另一个wsheet中选择）。我需要的颜色是自动更新以匹配第一个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
答案 0 :(得分：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值）