有條件格式化基於在其他細胞值單元的環形範圍在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 

事情需要注意：

• 不再有醜陋的使用選擇 - 獲得範圍r一次，完成所有的任務，在一個乾淨的塊的條件格式。

• 不再將新的條件格式設置爲優先。如有必要，將其重新編輯，但我猜測這只是宏錄像機所做的。

• 構建格式化公式以檢查直接在第一個單元格左邊的地址。請確保checkAddress的表達式符合您的期望，因爲我必須從您的圖片和代碼中推斷出它。如果值爲0/15/25的區域實際上是兩個合併的單元格（看起來像是這樣），那麼請確保此公式適用於上層單元格，因爲該單元格將是實際上保存該值的單元格。

• 再次，很難只從圖片告訴我們，但它看起來像你的每一個「行」的實際上是兩個細胞高（根據你的代碼，太）。所以你實際上一次只想通過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個步驟（不需要運行每條線）。

如果您對此代碼有任何疑問或問題，請詢問;）