0

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

比例不当的图表

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

比例不当的图表

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

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

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 变化的结果......

前

后

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

4

5 回答 5

1

可以测试吗：

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 建模

xMax = WorksheetFunction.Round(maxi + Adj/2, Round )
xMin = WorksheetFunction.Round(mini - Adj/2, Round )
于 2013-01-31T12:54:17.867 回答
1

好的，我自己又使用了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

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

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 通常在此处自动更适当地缩放。这也在负面和混合的 neg/pos 图表数据上进行了测试，并且似乎有效。

于 2013-01-31T16:11:41.147 回答
1

使用 Excel 计算的想法：MajorUnit 很好（假设总是正确的！！需要证明）。现在您正在寻找的圆形功能是：

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

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

于 2013-02-01T13:35:04.540 回答
0

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

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

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

于 2013-01-31T13:49:22.117 回答
0

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

于 2013-04-30T01:46:42.827 回答