根据 VBA 中其他单元格中的值对单元格的循环范围进行条件格式化

Question

我正在尝试根据每个单元格分组左侧的列中的数字有条件地格式化一系列单元格。基本上，如果在第 13 行中，每个单元格分组左侧的灰色列 = 0，那么我希望其右侧的整个单元格分组变为绿色，如果 = 15，则变为黄色，如果 = 25，则变为红色。第 12 行是我的代码现在正在发生的情况，第 13 行是我希望它看起来的样子。我似乎无法使循环正确。

Sub Highlight3()

   For i = 1 To ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row

     If Cells(i, 4) = "Highlight" Then
        For j = 1 To 15

     Range(Cells(i, j * 4 + 2), Cells(i + 1, j * 4 + 4)).Select

        Selection.FormatConditions.Delete
        Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$E = 0"
        Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
          With Selection.FormatConditions(1).Interior
           .Color = rgbRed
         End With

        Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$E= 15"
        Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
          With Selection.FormatConditions(1).Interior
           .Color = rgbGold
          End With

        Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$E = 25"
        Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
          With Selection.FormatConditions(1).Interior
           .Color = rgbGreen
          End With


       Next j
      End If
  Next i
End Sub

Answer 1

避免使用 Select，因为它既慢又不灵活。只需将您的范围直接分配给变量并使用它们即可。

Sub Highlight3()

    For i = 1 To ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row Step 2

        If Cells(i, 4) = "Highlight" Then
            For j = 1 To 15

            Dim r As Range
            Set r = Range(Cells(i, j * 4 + 2), Cells(i + 1, j * 4 + 4))

            Dim checkAddress As String
            checkAddress = Cells(i, j * 4 + 1).Address

            With r.FormatConditions
                .Delete

                .Add Type:=xlExpression, Formula1:="=" & checkAddress & " = 0"
                .Item(.Count).Interior.Color = rgbRed

                .Add Type:=xlExpression, Formula1:="=" & checkAddress & " = 15"
                .Item(.Count).Interior.Color = rgbGold

                .Add Type:=xlExpression, Formula1:="=" & checkAddress & " = 25"
                .Item(.Count).Interior.Color = rgbGreen
            End With

            Next j
        End If
    Next i
End Sub

注意事项：

不再丑陋地使用选择 - 获取 Range r 一次，并在一个干净的块中使用其条件格式完成所有任务。
不再将新的条件格式设置为第一优先级。如有必要，将其重新编辑，但我猜测这只是宏记录器所做的事情。
构建格式公式以检查第一个单元格左侧的地址。确保 checkAddress 的表达式是您所期望的，因为我必须从您的图片和代码中推断出来。如果值为 0/15/25 的区域实际上是两个合并的单元格（看起来有点像），那么请确保此公式适用于上部单元格，因为该单元格将是实际保存该值的单元格。
同样，仅凭图片很难分辨，但看起来您的每个 "rows" 实际上都是两个单元格高（也基于您的代码）。所以你实际上想要一次通过 2 个值而不是 1 个。

如果我刚刚列出的关于您的 table 格式的任何假设有误，请告诉我，我会帮助解决代码中的任何遗留问题。

Answer 2

这应该可以满足您的需求，而且速度更快：

Sub Highlight3()

  Dim i As Long, j As Byte, myCols As Range, myRng As Range

  Set myCols = Range("$B:$D")

  For i = 1 To ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row
    If Cells(i, 4) = "Highlight" Then

      If myRng Is Nothing Then
        Set myRng = Intersect(Rows(i), myCols)
      Else
        Set myRng = Union(myRng, Intersect(Rows(i), myCols))
      End If

      i = i + 1 'skip the line after, because it will never have a value / merged cell

    End If
  Next

  If myRng Is Nothing Then Exit Sub

  For i = 4 To 60 Step 4
    For j = 0 To 1
      With myRng.Offset(j, i)

        .Cells(1).Offset(-j).Activate
        .FormatConditions.Delete 'if that does not interfer with other stuff, better use the next line
        'If j = 0 Then myCols.Offset(, i).FormatConditions.Delete

        .FormatConditions.Add Type:=xlExpression, Formula1:="=" & .Cells(1).Offset(-j, -1).Address(0) & "=0"
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        .FormatConditions(1).Interior.Color = rgbRed

        .FormatConditions.Add Type:=xlExpression, Formula1:="=" & .Cells(1).Offset(-j, -1).Address(0) & "=15"
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        .FormatConditions(1).Interior.Color = rgbGold

        .FormatConditions.Add Type:=xlExpression, Formula1:="=" & .Cells(1).Offset(-j, -1).Address(0) & "=25"
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        .FormatConditions(1).Interior.Color = rgbGreen

      End With
    Next
  Next

End Sub

在本地测试它并且有效...可能存在我不知道的问题（最好用您的工作簿副本进行测试）。

第一部分将所有行推送到第二部分使用的范围内。这样，每组列只需要 2 个步骤（不需要运行每行）。

如果您对此代码有任何疑问或问题，请提问 ;)

根据 VBA 中其他单元格中的值对单元格的循环范围进行条件格式化

Conditionally formatting a looped range of cells based on value in other cell in VBA

excel

vba

loops

conditional-formatting