根据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$23 = 0"
        Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
          With Selection.FormatConditions(1).Interior
           .Color = rgbRed
         End With

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

        Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$E$23 = 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，因为它缓慢且不灵活。只需直接将您的 Ranges 分配给变量并使用它们。

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 的那个区域实际上是两个合并的单元格（有点像），那么请确保这个公式适用于上面的单元格，因为该单元格将是实际保存该值的单元格。

• 同样，仅凭一张图片很难分辨，但看起来您的每个“行”实际上都是两个单元格高（也基于您的代码）。因此，您实际上希望一次通过 2 个 i 的值，而不是一次 1 个。

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

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 个步骤（无需运行每一行）。

如果您对此代码有任何疑问或问题，请提出；）