vba 改进算法以根据图表数据适当缩放图表轴范围

Improve algorithm to scale chart axis limits appropriately based on the chart data

提问by harryg

I made this subroutine a while ago as I was dissatisfied with Excel's auto-scaling for charts. The built-in Excel method works to an extent but when the range of the chart data gets a bit wider it just sets the minimum scale to 0 which can result in very squished lines with loads of blank space beneath it. Like below...

不久前我做了这个子程序，因为我对 Excel 的图表自动缩放不满意。内置的 Excel 方法在一定程度上起作用，但是当图表数据的范围变宽时，它只会将最小比例设置为 0，这可能会导致非常压扁的线条下方有大量空白空间。像下面...

The code I wrote attempts to improve on excel's method by choosing a suitable max and min limit for the y-axis based on the data in the chart. It works OK but sometimes chooses not-the-best values. Here is the result from my code applied to the same chart:

我编写的代码试图通过根据图表中的数据为 y 轴选择合适的最大和最小限制来改进 excel 的方法。它工作正常，但有时会选择不是最好的值。这是我的代码应用于同一图表的结果：

Here it has fit all the data in the plot area so it is quite clear to see but the values it chose aren't the best. A human can look at this data and quickly assess that 90 and 140 are probably the best limits to use in this example but I've had trouble writing a script to do the same.

在这里，它拟合了绘图区域中的所有数据，因此可以很清楚地看到，但它选择的值并不是最好的。人类可以查看这些数据并快速评估 90 和 140 可能是本示例中使用的最佳限制，但我在编写脚本来执行相同操作时遇到了麻烦。

Here is the entire sub. It's not too long. I'd appreciate any suggestions to improve the calculation of the limits...

这是整个子。时间不算长。我很感激任何改进限制计算的建议......

Sub ScaleCharts()
'
' ScaleCharts Macro
'
Dim objCht As ChartObject
Dim maxi As Double, mini As Double, Range As Double, Adj As Double, xMax As Double, xMin As Double
Dim Round As Integer, Order As Integer, x As Integer, i As Integer

Application.ScreenUpdating = False
For x = 1 To ActiveWorkbook.Sheets.Count
Application.StatusBar = "Crunching sheet " & x & " of " & ActiveWorkbook.Sheets.Count

For Each objCht In Sheets(x).ChartObjects
  If objCht.Chart.ChartType = xlLine Or objCht.Chart.ChartType = xlXYScatter Then
  With objCht.Chart
  For i = 0 To .SeriesCollection.Count - 1 'Loop through all the series in the chart

            'Get the Max and Min values of the data in the chart
            maxi = Application.max(.SeriesCollection(i + 1).Values)
            mini = Application.min(.SeriesCollection(i + 1).Values)
            Range = maxi - mini

            If Range > 1 Then
                Order = Len(Int(Range))
                Adj = 10 ^ (Order - 2)
                Round = -1 * (Order - 1)
            ElseIf Range <> 0 Then
                Order = Len(Int(1 / Range))
                Adj = 10 ^ (-1 * Order)
                Round = Order - 1
            End If

            'Get the Max and Min values for the axis based on the data
            If i = 0 Or WorksheetFunction.Round(maxi, Round + 1) + Adj > xMax Then
            xMax = WorksheetFunction.Round(maxi, Round + 1) + Adj
            End If

            If i = 0 Or WorksheetFunction.Round(mini, Round + 1) - Adj < xMin Then
            xMin = WorksheetFunction.Round(mini, Round + 1) - Adj
            End If

       Next i

     With .Axes(xlValue)
        .MaximumScale = xMax
        .MinimumScale = xMin
     End With
  End With
  End If
Next objCht
Next x
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub

EDIT: Here are the results of qPCR4vir's changes...

编辑：以下是 qPCR4vir 更改的结果...

Before

前

After

后

The last 2 charts get cut off as they do not exceed -100

最后 2 个图表被截断，因为它们不超过 -100

回答by qPCR4vir

Can you test?:

可以测试吗：

Adj = 10 ^ (Order - 1)

and

和

xMax = WorksheetFunction.ROUNDDOWN(maxi + Adj, Round )
xMin = WorksheetFunction.ROUNDDOWN(mini , Round )

in place of:

代替：

Adj = 10 ^ (Order - 2)

and

和

xMax = WorksheetFunction.Round(maxi, Round + 1) + Adj

and

和

xMin = WorksheetFunction.Round(mini, Round + 1) - Adj

EDIT: ROUNDDOWN is incorrect for neg nummbers? We can model it with ROUND

编辑：ROUNDDOWN 对于否定数字不正确？我们可以用 ROUND 建模

xMax = WorksheetFunction.Round(maxi + Adj/2, Round )
xMin = WorksheetFunction.Round(mini - Adj/2, Round )

回答by harryg

OK I've had another go myself using the MajorUnitproperty suggested by Vicky

好的，我已经使用MajorUnitVicky 建议的属性进行了另一次尝试

Sub ScaleCharts3()
'
' ScaleCharts Macro
'
   Call revertCharts 'A macro that resets the charts to excel auto beforehand - this is so we get the correct "MajorUnit" value

   Dim objCht As ChartObject
   Dim maxi As Double, mini As Double, tryxMax As Double, tryxMin As Double, xMax As Double, xMin As Double, maju As Double
   Dim x As Integer, i As Integer

   Application.ScreenUpdating = False
   For x = 1 To ActiveWorkbook.Sheets.Count
   Application.StatusBar = "Crunching sheet " & x & " of " & ActiveWorkbook.Sheets.Count

   For Each objCht In Sheets(x).ChartObjects
      If objCht.Chart.ChartType = xlLine Or objCht.Chart.ChartType = xlXYScatter Then
      With objCht.Chart
      maju = .Axes(xlValue).MajorUnit
      For i = 0 To .SeriesCollection.Count - 1 'Loop through all the series in the chart

                'Get the Max and Min values of the data in the chart
                maxi = Application.max(.SeriesCollection(i + 1).Values)
                mini = Application.min(.SeriesCollection(i + 1).Values)

                'Get the Max and Min values for the axis based on the data
                tryxMax = roundToMult(maxi, maju)
                tryxMin = roundToMult(mini, maju, False)


                If i = 0 Or tryxMax > xMax Then
                xMax = tryxMax
                End If
                If i = 0 Or tryxMin < xMin Then
                xMin = tryxMin
                End If

           Next i

         With .Axes(xlValue)
            .MaximumScale = xMax
            .MinimumScale = xMin
         End With
      End With
      End If
   Next objCht
   Next x
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub

We also need a function that will round up and down to the nearest multiple accordingly as is referenced above.

我们还需要一个函数，可以相应地向上和向下舍入到最接近的倍数，如上所述。

Function roundToMult(numToRound As Double, multiple As Double, Optional up As Boolean = True)
numToRound = Int(numToRound)
multiple = Int(multiple)

If multiple = 0 Then
roundToMult = 0
Exit Function
End If

remainder = numToRound Mod multiple
If remainder = 0 Then
roundToMult = numToRound
Else
    If up = True Then
        roundToMult = (numToRound + multiple - remainder)
    Else
        If numToRound < 0 Then
            remainder = multiple + remainder
        End If
        roundToMult = (numToRound - remainder)
    End If
End If
End Function

There wont be any effect when used with small numbers (<1) but Excel usually scaled more appropriately automatically here. This is also tested on negative and mixed neg/pos chart data and seems to work.

与小数字 (<1) 一起使用时不会有任何影响，但 Excel 通常在此处自动缩放更合适。这也在负和混合负/正图表数据上进行了测试，并且似乎有效。

回答by qPCR4vir

The idea of using what Excel calculate: MajorUnit is good (assuming is allways rigth!! need to be proof). Now the round function you are looking for is:

使用 Excel 计算的想法：MajorUnit 很好（假设总是正确的！！需要证明）。现在你要找的圆函数是：

tryxMax = Sgn(maxi) * WorksheetFunction.MRound(Abs(maxi + maju / 2.001), maju)
tryxMin = Sgn(mini) * WorksheetFunction.MRound(Abs(mini - maju / 2.001), maju)

It work for all nummers, small or negative inclusive.

它适用于所有数字，包括小的或负的。

回答by Jon Peltier

Here's the approach I use: Calculate Nice Axis Scales in Excel VBA

这是我使用的方法： Calculate Nice Axis Scales in Excel VBA

回答by Vicky

What is the algorithm you use as a human when you say that 90 and 140 are the best values?

当您说 90 和 140 是最佳值时，您作为人类使用的算法是什么？

Personally I would look at the axis divisions that Excel has selected by default, and pick the closest divisions that lie outside the data itself. That would give you 80 and 140 in your example.

就我个人而言，我会查看 Excel 默认选择的轴分区，并选择位于数据本身之外的最接近的分区。在您的示例中，这将为您提供 80 和 140。

Excel calls this the "MajorUnit" property of the Axis object.

Excel 将其称为 Axis 对象的“MajorUnit”属性。