根据图表数据改进algorithm来适当缩放图表轴限制

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

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

在这里它适合所有的数据在绘图区域，所以很清楚看到，但它所select的值并不是最好的。 一个人可以看看这个数据，并快速评估90和140可能是在这个例子中使用的最好的限制，但我写了一个脚本也遇到了麻烦。

这是整个子。 这不是太长。 我会很感激任何build议，以改善限制的计算…

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 

编辑：这是qPCR4vir的变化的结果…

之前

后

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

Answer 1

使用什么Excel计算的想法：MajorUnit是好的（假设是总是rigth !!需要certificate）。 现在你正在寻找的轮function是：

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

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

Answer 2

好吧，我已经有另一个自己使用维基build议的MajorUnit属性

 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 

我们还需要一个函数，如上所述，将函数上下舍入到最接近的倍数。

 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 

使用小数字（<1）时不会有任何影响，但是Excel通常会在这里自动缩放。 这也是testing阴性和混合阴/阳图数据，似乎工作。

Answer 3

你可以testing吗？

 Adj = 10 ^ (Order - 1) 

和

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

代替：

 Adj = 10 ^ (Order - 2) 

和

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

和

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

编辑：ROUNDDOWN不正确的负数？ 我们可以用ROUND来build模

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

Answer 4

当你说90和140是最好的值时，你用什么algorithm作为人？

就我个人而言，我会看看Excel默认select的轴分区，并挑选数据本身之外的最靠近的分区。 这会给你80和140在你的例子。

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

Answer 5

这里是我使用的方法： 在Excel VBA中计算尼斯轴比例