Excel VBA 根据其他两个单元格中的值对单元格着色

Question

我正在尝试根据其他两个单元格的值用颜色填充范围内的单元格。

我与下面的 table 一起工作：

我想为 Type =“B”且 Helper1 = 1 或 Type =“C”且 Helper 2 = 1 的单元格着色。

想要的结果：

我能够使用条件格式来实现这一点，但是因为我无法将 cond 格式复制到其他工作簿（由于缺少辅助行），我需要在 VBA.[=14= 中执行此操作]

谁能给我指出正确的方向？

非常感谢！

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

Excel VBA 根据其他两个单元格中的值对单元格着色

Excel VBA color cell based on value in two other cells

excel

vba