根据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因为它速度慢且不灵活。 只需将范围直接分配给变量并使用它们即可。

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，并在一个干净的块中使用其条件格式执行所有任务。

• 不再将新的条件格式设置为具有优先级。 如有必要，请重新编辑该文件，但我猜测这只是Macro Recorder所做的。

• 构建格式公式以检查第一个单元格正好左侧的地址。 确保checkAddress的表达式符合您的期望，因为我必须从您的图片和代码中推断出它。 如果该值为0/15/25的区域实际上是两个合并的单元格（有点像），则请确保此公式适用于较高的单元格，因为该单元格将是实际保存该值的单元格。

• 同样，仅凭一张图片很难分辨，但是看起来每个“行”实际上高两个单元格（也基于您的代码）。 因此，您实际上想一次将i的值逐步增加2，而不是一次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个步骤（无需运行每行）。

如果您对此代码有任何疑问或问题，只需询问;）