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一次，并在一个干净的块中使用条件格式执行所有任务。
不再将新的条件格式设置为具有第一优先级。如果有必要，请重新编辑，但我猜这只是宏记录器所做的事情。
构建格式化公式以检查第一个单元格的左侧地址。确保checkAddress的表达式符合您的预期，因为我必须从您的图片和代码中推断出来。如果值为0/15/25的区域实际上是两个合并的单元格（有点看起来像），那么请确保该公式适用于上层单元格，因为该单元格将是实际保存该值的单元格。“ p>
再一次，很难从一张照片中看出来，但它看起来像你的每一行＆＃34;行＆＃34;实际上是两个单元格高（根据您的代码也是如此）。所以你实际上想要一次两个地逐步通过i的值，而不是一次一步。

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

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

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

第一部分推动第二部分中使用的范围内的所有行。这样，每个列只需要两个步骤（不需要每行都运行）。

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

有条件地根据VBA中其他单元格中的值格式化循环范围的单元格

2 个答案: