VBA根据条件添加三种不同颜色的数据栏

Question

我有一个Excel报告，其中数据栏必须根据三种不同的条件添加三种不同的颜色（红色，琥珀色和绿色）。以下代码完美无缺。但是，它将删除选区中已存在的所有条件格式。当我注释行Selection.FormatConditions.Delete，它会在行c.FormatConditions（1）.Formula =“= if（”& cellName &“< 0.8，true，则引发错误”对象不支持此属性或方法“ FALSE）”

我需要在现有格式的条件予以保留。能否请您帮忙吗？

Public Sub AddDataBars() 

Selection.FormatConditions.Delete 


For Each c In Selection 

Dim db As Databar 

Set db = c.FormatConditions.AddDatabar 
db.ShowValue = True 
db.MinPoint.Modify newtype:=xlConditionValueNumber, newvalue:=0 
db.MaxPoint.Modify newtype:=xlConditionValueNumber, newvalue:=1 
db.BarColor.Color = RGB(0, 255, 0) 
db.BarColor.TintAndShade = 0 
db.BarFillType = xlDataBarFillGradient 
db.Direction = xlContext 
db.NegativeBarFormat.ColorType = xlDataBarColor 
db.BarBorder.Type = xlDataBarBorderNone 
db.AxisPosition = xlDataBarAxisAutomatic 
db.AxisColor.Color = 0 
db.AxisColor.TintAndShade = 0 
db.NegativeBarFormat.Color.Color = 255 
db.NegativeBarFormat.Color.TintAndShade = 0 


Set db = c.FormatConditions.AddDatabar 
db.ShowValue = True 
db.MinPoint.Modify newtype:=xlConditionValueNumber, newvalue:=0 
db.MaxPoint.Modify newtype:=xlConditionValueNumber, newvalue:=1 
db.BarColor.Color = RGB(255, 192, 0) 
db.BarColor.TintAndShade = 0 
db.BarFillType = xlDataBarFillGradient 
db.Direction = xlContext 
db.NegativeBarFormat.ColorType = xlDataBarColor 
db.BarBorder.Type = xlDataBarBorderNone 
db.AxisPosition = xlDataBarAxisAutomatic 
db.AxisColor.Color = 0 
db.AxisColor.TintAndShade = 0 
db.NegativeBarFormat.Color.Color = 255 
db.NegativeBarFormat.Color.TintAndShade = 0 


Set db = c.FormatConditions.AddDatabar 
db.ShowValue = True 
db.MinPoint.Modify newtype:=xlConditionValueNumber, newvalue:=0 
db.MaxPoint.Modify newtype:=xlConditionValueNumber, newvalue:=1 
db.BarColor.Color = RGB(255, 130, 130) 
db.BarColor.TintAndShade = 0 
db.BarFillType = xlDataBarFillGradient 
db.Direction = xlContext 
db.NegativeBarFormat.ColorType = xlDataBarColor 
db.BarBorder.Type = xlDataBarBorderNone 
db.AxisPosition = xlDataBarAxisAutomatic 
db.AxisColor.Color = 0 
db.AxisColor.TintAndShade = 0 
db.NegativeBarFormat.Color.Color = 255 
db.NegativeBarFormat.Color.TintAndShade = 0 

cellName = c.Address 

c.FormatConditions(1).Formula = "=if(" & cellName & "<0.8, true, false)" 
c.FormatConditions(2).Formula = "=if(AND(" & cellName & ">=0.8, " & cellName & "<=1.00001), true, false)" 
c.FormatConditions(3).Formula = "=if(" & cellName & ">1.00001, true, false)" 

Next c 

End Sub 

Answer 1

既然你已经选择的细胞补充数据栏进入，您可以使用此范围内进行添加然后在同一范围内逐个修改每个条件格式。请注意，.FormatConditions索引不会更改，这是因为Excel会自动更改索引一旦条件被修改。所以，这个宏只能运行一次。此外，只有当您在选定范围内有3种现有格式条件时才能使用此功能。

这就是我想出来的。

Public Sub AddDataBars() 
    Dim db As Databar 

    Set db = Selection.FormatConditions.AddDatabar 
    db.ShowValue = True 
    db.MinPoint.Modify newtype:=xlConditionValueNumber, newvalue:=0 
    db.MaxPoint.Modify newtype:=xlConditionValueNumber, newvalue:=1 
    db.BarColor.Color = RGB(0, 255, 0) 
    db.BarColor.TintAndShade = 0 
    db.BarFillType = xlDataBarFillGradient 
    db.Direction = xlContext 
    db.NegativeBarFormat.ColorType = xlDataBarColor 
    db.BarBorder.Type = xlDataBarBorderNone 
    db.AxisPosition = xlDataBarAxisAutomatic 
    db.AxisColor.Color = 0 
    db.AxisColor.TintAndShade = 0 
    db.NegativeBarFormat.Color.Color = 255 
    db.NegativeBarFormat.Color.TintAndShade = 0 

    Set db = Selection.FormatConditions.AddDatabar 
    db.ShowValue = True 
    db.MinPoint.Modify newtype:=xlConditionValueNumber, newvalue:=0 
    db.MaxPoint.Modify newtype:=xlConditionValueNumber, newvalue:=1 
    db.BarColor.Color = RGB(255, 192, 0) 
    db.BarColor.TintAndShade = 0 
    db.BarFillType = xlDataBarFillGradient 
    db.Direction = xlContext 
    db.NegativeBarFormat.ColorType = xlDataBarColor 
    db.BarBorder.Type = xlDataBarBorderNone 
    db.AxisPosition = xlDataBarAxisAutomatic 
    db.AxisColor.Color = 0 
    db.AxisColor.TintAndShade = 0 
    db.NegativeBarFormat.Color.Color = 255 
    db.NegativeBarFormat.Color.TintAndShade = 0 

    Set db = Selection.FormatConditions.AddDatabar 
    db.ShowValue = True 
    db.MinPoint.Modify newtype:=xlConditionValueNumber, newvalue:=0 
    db.MaxPoint.Modify newtype:=xlConditionValueNumber, newvalue:=1 
    db.BarColor.Color = RGB(255, 130, 130) 
    db.BarColor.TintAndShade = 0 
    db.BarFillType = xlDataBarFillGradient 
    db.Direction = xlContext 
    db.NegativeBarFormat.ColorType = xlDataBarColor 
    db.BarBorder.Type = xlDataBarBorderNone 
    db.AxisPosition = xlDataBarAxisAutomatic 
    db.AxisColor.Color = 0 
    db.AxisColor.TintAndShade = 0 
    db.NegativeBarFormat.Color.Color = 255 
    db.NegativeBarFormat.Color.TintAndShade = 0 

    With Selection 
     With .FormatConditions(1) 
      If .Operator <> xlLess Then 
       .Modify xlCellValue, xlLess, "0.8" 
      Else 
       .Modify xlCellValue, xlGreater, "0.8" 
       .Modify xlCellValue, xlLess, "0.8" 
      End If 
      .StopIfTrue = False 
     End With 
     With .FormatConditions(1) 
      If .Operator <> xlBetween Then 
       .Modify xlCellValue, xlBetween, "0.8", "1.00001" 
      Else 
       .Modify xlCellValue, xlLess, "1.00001" 
       .Modify xlCellValue, xlBetween, "0.8", "1.00001" 
      End If 
      .StopIfTrue = False 
     End With 
     With .FormatConditions(1) 
      If .Operator <> xlGreater Then 
       .Modify xlCellValue, xlGreater, "1.00001" 
      Else 
       .Modify xlCellValue, xlLess, "1.00001" 
       .Modify xlCellValue, xlGreater, "1.00001" 
      End If 
      .StopIfTrue = False 
     End With 
    End With 
End Sub 

运行宏之前：

运行宏后： 您正在使用哪个版本的Excel