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