使用 vba 查找单元格颜色
vlookup for cell colors using vba
我在这个网站（和其他网站）上四处寻找答案，但三年后我一直没能找到正确的解决方案。我不想使用条件格式，因为我正在添加单元格并不断更改颜色。所以我正在寻找 vba 解决方案，但我不是这里的专家。
我有一个包含 20 个不同值（单元格 a1 到 t1）的工作表。在同一工作表中，我使用 vba 提取每个单元格（a2 到 t4）的 RGB 值。在不同的工作表中，a 有 5000+ table，在两列中，我 select 下拉列表中的 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
你可以这样做：
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
注意 - 进一步简化了这一点，只需直接提取 "key" 单元格颜色（无需提取和存储单独的 R、G 和 B 值）
我在这个网站（和其他网站）上四处寻找答案，但三年后我一直没能找到正确的解决方案。我不想使用条件格式，因为我正在添加单元格并不断更改颜色。所以我正在寻找 vba 解决方案，但我不是这里的专家。
我有一个包含 20 个不同值（单元格 a1 到 t1）的工作表。在同一工作表中，我使用 vba 提取每个单元格（a2 到 t4）的 RGB 值。在不同的工作表中，a 有 5000+ table，在两列中，我 select 下拉列表中的 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
你可以这样做：
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
注意 - 进一步简化了这一点，只需直接提取 "key" 单元格颜色（无需提取和存储单独的 R、G 和 B 值）