数十年来剔除蜱虫

Question

我有一个图表,其中一些数据具有线性y轴和对数x轴.问题是关于对数(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)

这就是它的样子:漂亮的网格,但轴不在正确的位置开始.

现在,当我没有专门将我的轴的最小值和最大值绕到十年时,

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

它看起来像这样,轴从正确的位置开始,但网格/刻度看起来很傻:

在这个例子中,我希望第一个刻度为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

Answer 1

如果您确实想要这样做,可以将垂直轴交叉更改为您想要开始的值.在这种情况下,我们将从18开始.

我们想要摆脱左边的丑陋轴,然后创建图表的副本并删除所有内容并删除除轴之外的所有填充颜色,如下图所示.然后,您创建一个没有边框的白色框,并覆盖原始图表Y轴.请注意,我忘记将线条颜色设置为"否",并将顶部图表的勾号设置为关闭.

接下来,您覆盖透明图表,您就可以获得所需内容.要使用VBA自动更新图表,您可以使用ActiveChart.Axes(xlCategory).CrossesAt = 20并对叠加图表和基础图表进行所有比例更改.

您可能想要使用另一个图形程序或只使用您发布的第一个图表,因为对于复杂的图表来说,这可能不值得您花时间.

代码自动执行:

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