Question

我想修改this answer中的代码，以便不会将范围增加1，而是将范围缩小1。关于如何做到这一点的任何想法？

Sub ChangeChartRange()

Dim i As Integer, r As Integer, n As Integer, p1 As Integer, p2 As Integer, p3 As Integer
Dim rng As Range
Dim ax As Range

'Cycles through each series
For n = 1 To ActiveChart.SeriesCollection.Count Step 1
    r = 0

    'Finds the current range of the series and the axis
    For i = 1 To Len(ActiveChart.SeriesCollection(n).Formula) Step 1
        If Mid(ActiveChart.SeriesCollection(n).Formula, i, 1) = "," Then
            r = r + 1
            If r = 1 Then p1 = i + 1
            If r = 2 Then p2 = i
            If r = 3 Then p3 = i
        End If
    Next i


    'Defines new range
    Set rng = Range(Mid(ActiveChart.SeriesCollection(n).Formula, p2 + 1, p3 - p2 - 1))
    Set rng = Range(rng, rng.Offset(0, 1))

    'Sets new range for each series
    ActiveChart.SeriesCollection(n).Values = rng

    'Updates axis
    Set ax = Range(Mid(ActiveChart.SeriesCollection(n).Formula, p1, p2 - p1))
    Set ax = Range(ax, ax.Offset(0, 1))
    ActiveChart.SeriesCollection(n).XValues = ax

Next n

End Sub

Answer 1

我认为你需要做的就是改变

Set rng = Range(rng, rng.Offset(0, 1))

到

Set rng = Range(rng, rng.Offset(0, -1))。

编辑：尝试更改此等式

Set rng = Range(Mid(ActiveChart.SeriesCollection(n).Formula, p2 + 1, p3 - p2 - 1))

例如，您可以尝试：

Set rng = Range(Mid(ActiveChart.SeriesCollection(n).Formula, p2 - 1, p3 - p2 - 1))

或

Set rng = Range(Mid(ActiveChart.SeriesCollection(n).Formula, p2 + 1, p3 + p2 - 1))

或

Set rng = Range(Mid(ActiveChart.SeriesCollection(n).Formula, p2 + 1, p3 - p2 + 1))

等等......

Answer 2

您可以在我的网站上使用免费加载项来调整图表系列公式。它像Find-Replace一样工作。读取系列公式中的最后一行数据，即更改值，减去一，得到更改值。本教程是Change Series Formula – Improved Routines，如果您想自己尝试一下，它会从一些VBA代码开始，但最后是指向“更改系列公式”加载项的链接。

Answer 3

我已经在原始代码中替换了两行，以便在每次运行宏时减少图表中的列数。

Sub ChangeChartRange()
    Dim i As Integer, r As Integer, n As Integer, p1 As Integer, p2 As Integer, p3 As Integer
    Dim rng As Range
    Dim ax As Range

    'Cycles through each series
    For n = 1 To ActiveChart.SeriesCollection.Count Step 1
        r = 0

        'Finds the current range of the series and the axis
        For i = 1 To Len(ActiveChart.SeriesCollection(n).Formula) Step 1
            If Mid(ActiveChart.SeriesCollection(n).Formula, i, 1) = "," Then
                r = r + 1
                If r = 1 Then p1 = i + 1
                If r = 2 Then p2 = i
                If r = 3 Then p3 = i
            End If
        Next i

        'Defines new range
        Set rng = Range(Mid(ActiveChart.SeriesCollection(n).Formula, p2 + 1, p3 - p2 - 1))
        Set rng = rng.Resize(rng.Rows.Count, rng.Columns.Count - 1) '~~> Replaced line

        'Sets new range for each series
        ActiveChart.SeriesCollection(n).Values = rng

        'Updates axis
        Set ax = Range(Mid(ActiveChart.SeriesCollection(n).Formula, p1, p2 - p1))
        Set ax = ax.Resize(ax.Rows.Count, ax.Columns.Count - 1)     '~~> Replaced line
        ActiveChart.SeriesCollection(n).XValues = ax

    Next n
End Sub

VBA：减少图表数据范围

3 个答案: