Question

我正在尝试在Excel图表上对最大和最小数字进行颜色编码。按照Peltiertech.com的想法，我有一个有效的代码。但问题是Excel中的数字被格式化为没有小数点（FormulaRange4.NumberFormat =“0”）。我的VBA公式检出的值未格式化。结果我的“min”被读作265.875而不是圆形266.因此，代码无法找到我的最小值。

有没有人有解决方案？下面是代码。子例程相当大，但关注部分以“'Sub wiseowltutorial（）”

开头

Set FormulaRange3 = .Range(.Cells(d, c + 2), .Cells(r - 1, c + 3))
FormulaRange3.NumberFormat = "0"
Set FormulaRange4 = .Range(.Cells(d, c + c + 3), .Cells(r - 1, c + c + 3))
FormulaRange4.NumberFormat = "0"
Set SelectRanges = Union(FormulaRange3, FormulaRange4)

SelectRanges.Select
ActiveSheet.Shapes.AddChart.Select
With ActiveChart
.Type = xlColumn
.HasTitle = True
.ChartTitle.Text = "Individual Employee Productivity"
.ChartTitle.Font.Bold = True
.Axes(xlCategory).HasTitle = True
.Axes(xlCategory).AxisTitle.Text = "Employees"
.Axes(xlValue).HasTitle = True
.Axes(xlValue).AxisTitle.Text = "Widgets Produced"
.Axes(xlValue).MajorGridlines.Delete
.ApplyDataLabels
.Legend.Delete
.Parent.Name = "Individual Employee Productivity"

结束

结束 '结束子

'Sub fromYouTubewiseowltutorial（） “找到合适的方式来突出每个团队中效率最高，效率最低的人或者

Dim ppApp As PowerPoint.Application
Dim ppPres As PowerPoint.Presentation
Dim ppSlide As PowerPoint.Slide
Dim ppTextbox As PowerPoint.Shape
Dim ppiPoint As Long
Dim ppvValues As Variant
Dim pprValue As Range

Dim lMax As Long
lMax = WorksheetFunction.Max(FormulaRange4)
Dim lMin As Long
lMin = WorksheetFunction.Min(FormulaRange4)

With ActiveChart.SeriesCollection(1)
    ppvValues = .Values
    For ppiPoint = 1 To UBound(ppvValues)
            If ppvValues(ppiPoint) = lMax Then
            .Points(ppiPoint).Format.Fill.ForeColor.RGB = RGB(0, 225, 0)
            End If
            If ppvValues(ppiPoint) = lMin Then
            .Points(ppiPoint).Format.Fill.ForeColor.RGB = RGB(225, 0, 0)
            End If

        Next
 End With

谢谢：）

Answer 1

尝试使用Round（）：

If Round(ppvValues(ppiPoint),0) = Round(lMax,0) Then
...
...
If Round(ppvValues(ppiPoint),0) = Round(lMin,0) Then

VBA在循环中格式化数字以进行条件格式设置

1 个答案: