VBA根据不同纸张上的范围值更改单元格颜色

Question

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

因此，如果在D列中导出的6位数代码是“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中的链接（在过滤模式下），清除过滤器

代码

包含这两个潜艇的新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

在主要工作表（Sheet2）的VBA模块中

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