VBA更改单元格颜色基于不同工作表上的范围值

Question

我有一个主窗体（Sheet2），其中用户在列C中输入一个长代码，并在D列中有一个公式设置为只取最后6位数长码。如果从单元格D中的公式导出的那些值等于名为“ref_list”（Sheet5）的单独工作表的C列中列出的任何值，那么我希望主工作表的F列中的相应单元格变为红色。一旦单元格颜色为红色，用户将能够点击列F中的红色单元格并导航到与列D中的6位数值关联的值列表。

因此，如果6位数字在D列派生的代码是“123ABC”，并且该值等于Sheet5列C中列出的代码之一，那么我希望同一行的F列单元变为红色并且可点击。一旦点击它将触发一个宏列出与“123ABC”相关的所有值。

现在，我硬编码了这些值和与它们相关的宏。我不想硬编码这些值，所以我把它们放在一个范围内。但是，我无法使逻辑工作。一旦范围设置完毕，我如何指定哪些单元格变为红色，以及如何触发与6位数值相关的适当宏。我已经研究了vba的范围，但是关于如何根据范围值调用宏，我没有很多运气找到任何资源。这是我迄今为止的代码。

Sub cellColorChange() 

Dim acctCode As Range 
Set acctCode = Sheet2.Range("D7:D446").Value 

Dim refCodes As Range 
Set refCodes = Sheet5.Range("C1:C20").Value 

Dim changeColor As Range 
Set changeColor = Sheet2.Range("F7:F446").Value 

If acctCode.Value = refCodes.Value Then 
changeColor.ActiveCell.Interior.Color = 3 
Else 
ActiveCell.Interior.Color = 0 
End If 

End Sub 

Answer 1

我的设置是Sheet2中和Sheet5（ “ref_list”） - 两片材有头

这是什么代码波纹管不会

Sheet2中（主片）

---

Sheet5（“ref_list”）

---

执行主子ShowCells（） - 结果

---

点击在F3中的链路过滤包含值 “123BCD”

所有项目

---

再次点击（在滤波器模式）在F3中的链接，清除过滤器

---

代码

---

含有这些2级潜艇的新VBA模块：

Option Explicit 

Private Const S2 = "Sheet2" 'Name of the main sheet 
Private Const WS1_COL = 4 'Column in main sheet (D) 
Private Const WS1_F = 6  'Column in main sheet (F) 
Private Const WS2_COL = 3 'Column in ref_list sheet (C) 

Public Sub ShowCells() 
    Dim ws1 As Worksheet, ws2 As Worksheet, r1 As Long, r2 As Long 
    Dim ur1 As Variant, ur2 As Variant, ub2 As Long, cel As Range, lnk As Range 

    Set ws1 = ThisWorkbook.Sheets(S2) 
    Set ws2 = ThisWorkbook.Sheets("ref_list") 

    ur1 = ws1.UsedRange.Columns(WS1_COL) 
    ur2 = ws2.UsedRange.Columns(WS2_COL) 
    ub2 = UBound(ur2) 

    Application.ScreenUpdating = False 
    For r1 = 2 To UBound(ur1) 
     For r2 = 2 To ub2 
      If ur1(r1, 1) = ur2(r2, 1) Then 
       Set cel = ws1.Cells(r1, WS1_COL) 
       Set lnk = cel.Offset(0, WS1_F - WS1_COL) 
       lnk.Interior.ColorIndex = 3 
       ws1.Hyperlinks.Add Anchor:=lnk, Address:="", SubAddress:=cel.Address 
       Exit For 
      End If 
     Next 
    Next 
    Application.ScreenUpdating = True 
End Sub 

---

Public Sub ShowRefs(ByVal id As String) 
    Dim ws As Worksheet 
    Set ws = ThisWorkbook.Sheets(S2) 
    ws.UsedRange.Columns(WS1_COL).AutoFilter Field:=1, Criteria1:=ws.Range(id).Value 
End Sub 

---

在VBA模块主表（Sheet2的）

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink) 
    If Me.AutoFilter Is Nothing Then 
     ShowRefs Target.SubAddress 
    Else 
     Me.UsedRange.AutoFilter 
    End If 
End Sub