有沒有辦法在VBA中創建條件格式回圈？

我有一張從 D5 到 AM39 的大桌子。每列在單元格 D40、E40、F40 等中都有其平均值。我想格式化單元格，以便如果該列中的數字高于平均值，則顏色為綠色，如果顏色較低，則為紅色。

我對 VBA 非常陌生，但到目前為止，這個腳本應該給單元格著色，但它不起作用（我認為這與 Cells(4,39) 索引錯誤有關，但我不確定。

Application.CutCopyMode = False

With Range(Cells(5, 39), Cells(4, 39))
  .FormatConditions.Delete

  .FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
    Formula1:="=$D40"
 .FormatConditions(1).Interior.color = RGB(0, 150, 0)

End With
End Sub

欣賞任何提示

編輯********

使用記錄宏功能，我相信我對我正在尋找的內容有一個更接近的解決方案，但是，格式與每行的平均值不一致（單元格是紅色的，應該是綠色的，反之亦然）

With Range(Cells(39, 4), Cells(5, 39)).Select
Application.CutCopyMode = False
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _
    Formula1:="=D$40"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
    .color = -16752384
    .TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
    .PatternColorIndex = xlAutomatic
    .color = 13561798
    .TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Application.CutCopyMode = False
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
    Formula1:="=D$40"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
    .color = -16383844
    .TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
    .PatternColorIndex = xlAutomatic
    .color = 13551615
    .TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
  End With
  End Sub

uj5u.com熱心網友回復：

試試這個（使用內置的“比較平均”CF 功能）

Sub AddCF()
    
    Dim rngData As Range, col As Range
    
    Set rngData = ActiveSheet.Range("D5:AM39") 'your table data

    Application.ScreenUpdating = False
    For Each col In rngData.Columns            'for each column in the data range
        With col.FormatConditions.AddAboveAverage  'for >Avg
            .AboveBelow = xlAboveAverage
            .Interior.Color = vbRed
        End With
        With col.FormatConditions.AddAboveAverage  'for <Avg
            .AboveBelow = xlBelowAverage
            .Interior.Color = 5296274
        End With
    Next col
    
End Sub

如果您想使用現有的平均公式：

Sub AddCF2()
    
    Dim rngData As Range, col As Range, addr
    
    Set rngData = ActiveSheet.Range("D5:AM39")

    Application.ScreenUpdating = False
    For Each col In rngData.Columns 'for each column in the data range
        'absolute row, relative column address
        addr = col.Cells(col.Cells.Count).Offset(1).Address(True, False) 'avg cell address
    
        With col.FormatConditions
            With .Add(Type:=xlCellValue, Operator:=xlGreater, Formula1:="=" & addr)
                .Font.Color = -16383844
                .Interior.Color = 13551615
            End With
            With .Add(Type:=xlCellValue, Operator:=xlLess, Formula1:="=" & addr)
                .Font.Color = -16752384
                .Interior.Color = 13561798
            End With
        End With
    Next col
    
End Sub

標籤：擅长 vba 循环 格式化

上一篇：識別輸入文本檔案中的回圈和方法的java代碼

下一篇：如何將檔案的每一行保存到一個新檔案（每一行一個新檔案）并為多個原始檔案執行此操作