Привязка к десятилетиям

У меня есть диаграмма с некоторыми данными с линейной осью y и логарифмической осью x. Речь идет о логарифмической (x-) оси.

Я хочу, чтобы логарифмические клещи по оси х выровнялись с точными десятилетиями (степень 10), но я не хочу, чтобы ось начиналась с нужных десятилетий; Я хочу, чтобы он начинался с начала моих данных. Так, например, ось может начинаться с 3; но первый основной тик должен быть в 10. Как мне это сделать?

В настоящее время, когда я устанавливаю ось, начинающуюся с 3, основная линия сетки равна 3, что бесполезно.

Когда я устанавливаю следующие свойства, сетка и тики хороши, но это потому, что я заставляю ось начинать с десятилетия (чего я не хочу делать).

.Chart.Axes(xlCategory).ScaleType = xlScaleLogarithmic
.Chart.Axes(xlCategory).HasMajorGridlines = True
.Chart.Axes(xlCategory).HasMinorGridlines = True
.Chart.Axes(xlCategory).MinimumScale = 10 ^ (Int(Application.Log10(Cells(DATA_START, 6))))
.Chart.Axes(xlCategory).MaximumScale = 10 ^ (Int(Application.Log10(Cells(DATA_START + n, 6)) - 0.00001) + 1)

Вот как это выглядит: хорошая сетка, но ось не начинается в нужном месте.

enter image description here

Теперь, когда я специально не округляю min и max моей оси до десятилетия,

' ...
.Chart.Axes(xlCategory).MinimumScale = 0.9 * Cells(DATA_START, 6)
.Chart.Axes(xlCategory).MaximumScale = 1.1 * Cells(DATA_START + n, 6)

он выглядит так: ось начинается в нужном месте, но сетка/тики выглядит глупо:

enter image description here

В этом примере я ожидаю, что перед первым тиком будет 100 и только незначительные тики/сетки до этого.

Я уже понял, что могу установить мультипликативный множитель между двумя основными тиками .MajorUnit = 10.

У меня есть SSCCE для вас: просто запустите этот макрос на пустом листе. Он создает диаграмму с основными тиками (и сетками) в 18, 180, 1800, но я хочу их в 100, 1000.

Sub CreateDemoPlot()
    Range("A1:A6") = Application.Transpose(Split("20,40,100,1000,4500,10000", ","))
    Range("B1:B6") = Application.Transpose(Split("-30,-50,-90,-70,-75,-88", ","))
    With ActiveSheet.ChartObjects.Add(Left:=100, Width:=400, Top:=100, Height:=200)
        .Chart.SeriesCollection.NewSeries
        .Chart.ChartType = xlXYScatterLinesNoMarkers
        .Chart.Axes(xlValue).ScaleType = xlLinear
        .Chart.Axes(xlValue).CrossesAt = -1000
        .Chart.Axes(xlCategory).ScaleType = xlScaleLogarithmic
        .Chart.Axes(xlCategory).HasMajorGridlines = True
        .Chart.Axes(xlCategory).HasMinorGridlines = True
        .Chart.Axes(xlCategory).MinimumScale = 0.9 * Cells(1, 1)
        .Chart.Axes(xlCategory).MaximumScale = 1.1 * Cells(6, 1)
        .Chart.Axes(xlCategory).MajorUnit = 10
        .Chart.HasLegend = False

        .Chart.SeriesCollection.NewSeries
        .Chart.SeriesCollection(1).XValues = Range("A1:A6")
        .Chart.SeriesCollection(1).Values = Range("B1:B6")
    End With
End Sub

Ответы

Ответ 1

Если вы действительно хотите это сделать, вы можете изменить поперечные оси вертикальной оси на значение, с которого вы хотите начать. В этом случае мы начнем с 18.  1

Мы хотим избавиться от уродливой оси слева, чтобы затем создать копию диаграммы и удалить все и удалить все цвета заливки, за исключением оси, такой как приведенная ниже диаграмма. Затем вы создаете белый ящик без границ и закрываете исходную ось Y диаграммы. Обратите внимание, что я забыл установить цвет линии на "Нет" и отметки для верхней диаграммы.  2

Затем вы накладываете прозрачный график и получаете то, что хотите. Чтобы использовать VBA для автоматического обновления диаграммы, вы можете использовать ActiveChart.Axes(xlCategory).CrossesAt = 20 и произвести все изменения масштаба как для диаграммы наложения, так и для базовой диаграммы.

Вы можете использовать другую графическую программу или просто использовать первый график, который вы опубликовали, потому что, вероятно, не стоит тратить время на это для сложных диаграмм. 3

Код для этого автоматически:

Sub CreateDemoPlot()
    Dim chart2 As ChartObject
    Dim shape1 As shape

    Range("A1:A6") = Application.Transpose(Split("20,40,100,1000,4500,10000", ","))
    Range("B1:B6") = Application.Transpose(Split("-30,-50,-90,-70,-75,-88", ","))
    Range("D3:K15").Name = "ChartArea" 'Set Chart Area
    With ActiveSheet.ChartObjects.Add(Left:=100, Width:=400, Top:=100, Height:=200)
        .Chart.SeriesCollection.NewSeries
        .Chart.ChartType = xlXYScatterLinesNoMarkers
        .Chart.Axes(xlValue).ScaleType = xlLinear
        .Chart.Axes(xlValue).CrossesAt = -1000
        .Chart.Axes(xlCategory).ScaleType = xlScaleLogarithmic
        .Chart.Axes(xlCategory).HasMajorGridlines = True
        .Chart.Axes(xlCategory).HasMinorGridlines = True
        .Chart.Axes(xlCategory).MinimumScale = 0.9 * Cells(1, 1)
        .Chart.Axes(xlCategory).MaximumScale = 1.1 * Cells(6, 1)
        .Chart.Axes(xlCategory).MajorUnit = 10
        .Chart.HasLegend = False

        .Chart.SeriesCollection.NewSeries
        .Chart.SeriesCollection(1).XValues = Range("A1:A6")
        .Chart.SeriesCollection(1).Values = Range("B1:B6")

        .Chart.Axes(xlCategory).CrossesAt = 18 'Or where ever the actual data starts
        .Chart.Axes(xlCategory).MinimumScale = 10 'Set to 10 instead of the above code

        'position to chart area
        .Top = Range("ChartArea").Top
        .Left = Range("ChartArea").Left
        .Copy

        'create white box
        ActiveSheet.Shapes.AddShape msoShapeRectangle, 50, 50, 45, 200
        Set shape1 = ActiveSheet.Shapes(2)
        shape1.Fill.ForeColor.RGB = RGB(255, 255, 255)
        shape1.Line.ForeColor.RGB = RGB(255, 255, 255)

        'Position whitebox
        shape1.Left = Range("ChartArea").Left
        shape1.Top = Range("ChartArea").Top

        'Paste overlay chart
        ActiveSheet.Paste
        Set chart2 = ActiveSheet.ChartObjects("Chart 3")

        'Position overlay Chart
        chart2.Top = Range("ChartArea").Top
        chart2.Left = Range("ChartArea").Left

        'Clear out overlay chart
        chart2.Chart.Axes(xlValue).Format.Line.Visible = msoFalse
        chart2.Chart.SeriesCollection(1).Format.Line.Visible = msoFalse
        chart2.Chart.PlotArea.Format.Fill.Visible = msoFalse
        chart2.Chart.Axes(xlCategory).Delete
        chart2.Chart.SetElement (msoElementPrimaryValueGridLinesNone)
        chart2.Chart.SetElement (msoElementPrimaryCategoryGridLinesNone)
        chart2.Chart.ChartArea.Format.Fill.Visible = msoFalse

        'Adjust Y axis position from overlay chart
        chart2.Chart.PlotArea.Left = 10
        chart2.Chart.PlotArea.Top = 0
    End With
End Sub

Ответ 2

Я считаю, что смог уговорить Excel создать именно тот граф, который вы просили использовать следующий странный набор шагов:

  • Создайте график журнала с нужными пределами
  • Отключить вертикальные линии сетки
  • создайте новый массив со значениями линий сетки, которые вы хотите (например, 70, 80, 90, 100, 200, 300 и т.д.).
  • Разделите вторую серию, где требуемые значения сетки - это X, а отрицательный предел графика - Y (одинаковое значение для всех них)
  • Не используйте маркеры, и для этой серии нет строки
  • Добавить бары ошибок для Y - только в положительном направлении со значением, равным общему диапазону оси Y (max - min)
  • Добавить метки данных в серию, только представленное значение X
  • Переместите метку под точкой

Результат:

enter image description here

Это лог-график; ярлыки верны; "линии сетки" верны. Это красиво.

Теперь для автоматизации этого... К сожалению, у меня нет времени прямо сейчас, чтобы создать "очищенную" версию кода, необходимую для этого (когда вы записываете это как макрос, он создает обычный беспорядок Excel...) но если вы выполните приведенные выше инструкции, чтобы сделать это вручную, вы действительно получите именно этот график.