Код VBA для автоматического изменения диапазонов оси Y

Question

В настоящее время я использую следующий код для автоматического обновления минимальной и максимальной значений по оси Y для диаграмм в Excel:

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 000 и т. д.(то есть эквивалент функции = ROUND (A1, -1) в Excel), чтобы избежать оси, которая идет от 4247 до 6747 (мне нравится, чтобы она была от 4250 до 6750)

Любойидеи?

Спасибо,

Томас

Answer 1

Для значений min / max вы можете использовать:

'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)

Идея состоит в том, что после определения значений min и max вы округляетеих с использованием функций ROUNDUP и ROUNDDOWN листа