VBA代码可自动更改y轴范围

时间:2018-12-04 16:27:15

标签: excel vba excel-vba

我当前正在使用以下代码来自动更新excel中图表的y轴最小值和最大值:

Sub AdjustVerticalAxis()
'PURPOSE: Adjust Y-Axis according to Min/Max of Chart Data

Dim cht As ChartObject
Dim srs As Series
Dim FirstTime  As Boolean
Dim MaxNumber As Double
Dim MinNumber As Double
Dim MaxChartNumber As Double
Dim MinChartNumber As Double
Dim Padding As Double

'Input Padding on Top of Min/Max Numbers (Percentage)
  Padding = 0.1  'Number between 0-1

'Optimize Code
  Application.ScreenUpdating = False

'Loop Through Each Chart On ActiveSheet
  For Each cht In ActiveSheet.ChartObjects

'First Time Looking at This Chart?
  FirstTime = True

'Determine Chart's Overall Max/Min From Connected Data Source
  For Each srs In cht.Chart.SeriesCollection
    'Determine Maximum value in Series
      MaxNumber = Application.WorksheetFunction.Max(srs.Values)

    'Store value if currently the overall Maximum Value
      If FirstTime = True Then
        MaxChartNumber = MaxNumber
      ElseIf MaxNumber > MaxChartNumber Then
        MaxChartNumber = MaxNumber
      End If

    'Determine Minimum value in Series (exclude zeroes)
      MinNumber = Application.WorksheetFunction.Min(srs.Values)

    'Store value if currently the overall Minimum Value
      If FirstTime = True Then
        MinChartNumber = MinNumber
      ElseIf MinNumber < MinChartNumber Or MinChartNumber = 0 Then
        MinChartNumber = MinNumber
      End If

    'First Time Looking at This Chart?
      FirstTime = False
  Next srs

'Rescale Y-Axis
  cht.Chart.Axes(xlValue).MinimumScale = MinChartNumber * (1 - Padding)
  cht.Chart.Axes(xlValue).MaximumScale = MaxChartNumber * (1 + Padding)

  Next cht

'Optimize Code
  Application.ScreenUpdating = True

End Sub

代码工作正常,我想进行以下调整:

  1. 我希望代码仅在我选择的图表上运行(即不是一次全部显示)
  2. 代码输出的y轴最大值和最小值四舍五入到最接近的10,100,1000等。 (即等于Excel中的= ROUND(A1,-1)函数),以避免出现从4247到6747的轴(我希望它从4250到6750)

有什么想法吗?

谢谢

托马斯

1 个答案:

答案 0 :(得分:0)

对于最小值/最大值,您可以使用:

sudo chown www-data:www-data /var/www/html/project-name/path/to/folder

类似地:

'Determine Maximum value in Series
MaxNumber = Application.WorksheetFunction.Max(srs.Values)
MaxNumber  = Application.WorksheetFunction.RoundUp(MaxNumber, -1)

这个想法是,在确定最小值和最大值之后,可以使用'Determine Minimum value in Series (exclude zeroes) MinNumber = Application.WorksheetFunction.Min(srs.Values) MinNumber = Application.WorksheetFunction.RoundDown(MinNumber, -1) ROUNDUP工作表函数对它们进行四舍五入