Excel VBA顏色單元格基於其他兩個單元格中的值

Question

我正在嘗試根據其他兩個單元格的值用顏色填充某個范圍內的單元格。

我使用下表：

我想為 Type = "B" 和 Helper1 = 1 或 Type = "C" 和 Helper 2 = 1 的單元格着色。

期望的結果：

我能夠使用條件格式來實現這一點，但是因為我無法將 cond 格式復制到其他工作簿（由於缺少幫助行），所以我需要在 VBA 中進行。

誰能在這里指出我正確的方向？

非常感謝！

Answer 1

只需遍歷每個單元格並檢查第一列是否等於 B 或 C 以及數據的第 1 行或第 2 行是否等於 1

Application.ScreenUpdating = False
Dim rng As Range

For Each rng In Range("A1").CurrentRegion
    If rng.Column = 1 Or rng.Row = 1 Or rng.Row = 2 Then
        'do nothing, headers and first column
    Else
        If Cells(rng.Row, 1) = "B" And Cells(1, rng.Column) = 1 Then rng.Interior.Color = vbYellow 'if first column=B and Helper1=1
        If Cells(rng.Row, 1) = "C" And Cells(2, rng.Column) = 1 Then rng.Interior.Color = vbYellow 'if first column=B and Helper2=1
    End If
Next rng
Application.ScreenUpdating = True

注意 H 列沒有黃色，因為 Helper1 和 Helper2 都是零（我這樣做是為了測試）

Answer 2

即使您收到了答案，也請測試下一個方法。 它應該快一點：

Sub colorRangesConditionally()
   Dim sh As Worksheet, lastR As Long, arr, rngH1 As Range, rngH2 As Range, i As Long
   
   Set sh = ActiveSheet
   lastR = sh.Range("A" & sh.rows.count).End(xlUp).Row
   
   arr = sh.Range("A1:M" & lastR).Value2 'place the range in an array for faster iteration
   sh.Range("A3:M" & lastR).ClearFormats 'clear format of the previous runs
   
   For i = 2 To 13
        If arr(1, i) = 1 Then addToRange rngH1, sh.cells(1, i)
        If arr(2, i) = 1 Then addToRange rngH2, sh.cells(2, i)
   Next i
   Set rngH1 = rngH1.EntireColumn
   Set rngH2 = rngH2.EntireColumn
   
   Application.ScreenUpdating = False
   For i = 3 To UBound(arr)
        If arr(i, 1) = "B" And Not Intersect(rows(i), rngH1) Is Nothing Then
            Intersect(rows(i), rngH1).Interior.Color = vbYellow
        End If
        If arr(i, 1) = "C" And Not Intersect(rows(i), rngH2) Is Nothing Then
            Intersect(rows(i), rngH2).Interior.Color = vbYellow
        End If
   Next i
   Application.ScreenUpdating = True
End Sub

Sub addToRange(rngU As Range, rng As Range)
    If rngU Is Nothing Then
        Set rngU = rng
    Else
        Set rngU = Union(rngU, rng)
    End If
End Sub