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