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

Question

我正在尝试对 Excel 图表上的最大和最小数字进行颜色编码。按照 Peltiertech.com 的想法，我有一个有效的代码。然而问题是 Excel 中的数字被格式化为没有小数点 (FormulaRange4.NumberFormat = "0")。我的 VBA 公式检查的值未格式化。结果，我的“最小值”被读取为 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 from YouTubewiseowltutorial() '找到正确的方法来突出每个团队中效率最高和效率最低的人或人

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