【20170727】VBA宏：根據達成率分紅藍綠三種進度條（不同數據顯示不同顏色）
老闆的要求是：超過100%綠色進度條，超過當月應達成的，藍色，沒趕上當月應有進度的，紅色。
因為是初學者，三種進度條是靠錄宏得到的代碼，蠻長的，如果之後技術長進，會來優化。
Sub 進度條()
進度條分三種顏色 宏
清除所有規則
ActiveWindow.SmallScroll Down:=-9
Range("AK4:AK26").Select
Selection.FormatConditions.Delete
紅色字體
Range("AK4:AK26").Select
Application.CutCopyMode = False
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
Formula1:="=$AH$2"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.Color = -16776961
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
ActiveWindow.SmallScroll Down:=0
畫數據條
Dim i As Integer
For i = 4 To 25
MsgBox (i)
If Range("AK" & i).Value >= 1 Then
MsgBox (("AK" & i))
Range("AK" & i).Name = "green"
Range("green,AK29,AK30").Select
Range("AK30").Activate
Selection.FormatConditions.AddDatabar
Selection.FormatConditions(Selection.FormatConditions.Count).ShowValue = True
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1)
.MinPoint.Modify newtype:=xlConditionValueAutomaticMin
.MaxPoint.Modify newtype:=xlConditionValueAutomaticMax
End With
With Selection.FormatConditions(1).BarColor
.Color = 8700771
.TintAndShade = 0
End With
Selection.FormatConditions(1).BarFillType = xlDataBarFillGradient
Selection.FormatConditions(1).Direction = xlContext
Selection.FormatConditions(1).NegativeBarFormat.ColorType = xlDataBarColor
Selection.FormatConditions(1).BarBorder.Type = xlDataBarBorderSolid
Selection.FormatConditions(1).NegativeBarFormat.BorderColorType = _
xlDataBarColor
With Selection.FormatConditions(1).BarBorder.Color
.Color = 8700771
.TintAndShade = 0
End With
Selection.FormatConditions(1).AxisPosition = xlDataBarAxisAutomatic
With Selection.FormatConditions(1).AxisColor
.Color = 0
.TintAndShade = 0
End With
With Selection.FormatConditions(1).NegativeBarFormat.Color
.Color = 255
.TintAndShade = 0
End With
With Selection.FormatConditions(1).NegativeBarFormat.BorderColor
.Color = 255
.TintAndShade = 0
End With
Else
If (Range("AK" & i).Value >= Range("AH2").Value And Range("AK" & i).Value < 1) Then
MsgBox (("AK" & i))
Range("AK" & i).Name = "blue"
Range("blue,AK29,AK30").Select
Range("AK30").Activate
Selection.FormatConditions.AddDatabar
Selection.FormatConditions(Selection.FormatConditions.Count).ShowValue = True
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1)
.MinPoint.Modify newtype:=xlConditionValueAutomaticMin
.MaxPoint.Modify newtype:=xlConditionValueAutomaticMax
End With
With Selection.FormatConditions(1).BarColor
.Color = 13012579
.TintAndShade = 0
End With
Selection.FormatConditions(1).BarFillType = xlDataBarFillGradient
Selection.FormatConditions(1).Direction = xlContext
Selection.FormatConditions(1).NegativeBarFormat.ColorType = xlDataBarColor
Selection.FormatConditions(1).BarBorder.Type = xlDataBarBorderSolid
Selection.FormatConditions(1).NegativeBarFormat.BorderColorType = _
xlDataBarColor
With Selection.FormatConditions(1).BarBorder.Color
.Color = 13012579
.TintAndShade = 0
End With
Selection.FormatConditions(1).AxisPosition = xlDataBarAxisAutomatic
With Selection.FormatConditions(1).AxisColor
.Color = 0
.TintAndShade = 0
End With
With Selection.FormatConditions(1).NegativeBarFormat.Color
.Color = 255
.TintAndShade = 0
End With
With Selection.FormatConditions(1).NegativeBarFormat.BorderColor
.Color = 255
.TintAndShade = 0
End With
Else
If Range("AK" & i).Value < Range("AH2").Value Then
MsgBox (("AK" & i))
Range("AK" & i).Name = "red"
Range("red,AK29,AK30").Select
Range("AK30").Activate
Selection.FormatConditions.AddDatabar
Selection.FormatConditions(Selection.FormatConditions.Count).ShowValue = True
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1)
.MinPoint.Modify newtype:=xlConditionValueAutomaticMin
.MaxPoint.Modify newtype:=xlConditionValueAutomaticMax
End With
With Selection.FormatConditions(1).BarColor
.Color = 5920255
.TintAndShade = 0
End With
Selection.FormatConditions(1).BarFillType = xlDataBarFillGradient
Selection.FormatConditions(1).Direction = xlContext
Selection.FormatConditions(1).NegativeBarFormat.ColorType = xlDataBarColor
Selection.FormatConditions(1).BarBorder.Type = xlDataBarBorderSolid
Selection.FormatConditions(1).NegativeBarFormat.BorderColorType = _
xlDataBarColor
With Selection.FormatConditions(1).BarBorder.Color
.Color = 5920255
.TintAndShade = 0
End With
Selection.FormatConditions(1).AxisPosition = xlDataBarAxisAutomatic
With Selection.FormatConditions(1).AxisColor
.Color = 0
.TintAndShade = 0
End With
With Selection.FormatConditions(1).NegativeBarFormat.Color
.Color = 255
.TintAndShade = 0
End With
With Selection.FormatConditions(1).NegativeBarFormat.BorderColor
.Color = 255
.TintAndShade = 0
End With
End If
End If
End If
Next i
End Sub
推薦閱讀：
※【Excel技巧】- 員工生日提醒不再難
※EXCEL VBA小白第六課：豆瓣精選話題爬蟲數據分析小嘗試
※一個word文檔裡邊有很多內容是Access資料庫里的內容，如何能自動綁定到資料庫？
※關於在Excel VBA中使用方括弧表示Range的問題
※用Excel和OutLook實現自動批量發郵件