Question

我目前有数据，我正在绘制图表，如下所示：

Period     0       1     2     3
Variable   2.1    2.5   2.8   3.0

我目前有VBA，每次运行时都会将我的图表范围扩展一列。但是，我想知道是否有更有效的方法对其进行编码，以便VBA计算我的工作表的最后一列，其中包含数据并相应地绘制数据点。我当前代码的一个问题是，如果我不小心运行VBA太多次，我的图表上会有空白单元格。

Sub ChangeChartRange()

    'Defines objects
    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
    Dim wks As Worksheet
    Dim cht As ChartObject

    Set CurrentSheet = ActiveSheet

    'For () loop statement that cycles through each worksheet
    For Each wks In ActiveWorkbook.Worksheets

    'Activates workbook
    wks.Activate

    'For () loop statement that cycles through each chart
    For Each cht In ActiveSheet.ChartObjects

        'Activates chart
        cht.Activate

        'Start counter at 0
        r = 0

        'Finds the current range of the series and the axis
        For i = 1 To Len(ActiveChart.SeriesCollection(1).Formula) Step 1
            If Mid(ActiveChart.SeriesCollection(1).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(1).Formula, p2 + 1, p3 - p2 - 1))
        Set rng = Range(rng, rng.Offset(0, 1))

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

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

    Next cht
    Next wks

End Sub

非常感谢帮助！我对VBA还是一个新手 - 我在网上把这个代码拉到了某个地方。我一直在努力学习！

Answer 1

如果数据中间没有任何空白单元格，并且右侧的下一列为空白，则可以使用rng.End(xlToRight)查找包含数据的最后一个单元格。您可以在下面的代码中看到，我已将.Offset(0,1)替换为.End(xlToRight)新范围和轴。

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

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

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

ActiveChart.SeriesCollection的解释（1）.Formula

在我的图表中，我提取了SeriesCollection(1).Formula。它看起来像这样："=SERIES('Jan 17'!$D$7:$D$8,'Jan 17'!$C$9:$C$33,'Jan 17'!$D$9:$D$33,1)" 在此字符串中，第一个范围是描述，第二个范围是轴，第三个范围是相关数据。

以下代码一次遍历此字符串一个字符。如果当前字符是逗号，r会更新，p1，p2和p3的条件值会在r达到正确值时分配。 p1是第一个逗号后面的第一个字符（轴字符串的开头）。 p2是第二个逗号的位置（轴和数据之间的分隔符）。 p3是第三个逗号的位置（数据字符串后面的第一个字符）。

For i = 1 To Len(ActiveChart.SeriesCollection(1).Formula) Step 1
    If Mid(ActiveChart.SeriesCollection(1).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

代码的下一部分提取从数据开始的字符串部分，以获取数据的长度。 'Jan 17'!$D$9:$D$33将其转换为范围对象，然后对其进行扩展。

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

以下代码提取从轴开始处开始的字符串部分，以获取轴的长度。 'Jan 17'!$C$9:$C$33将其转换为范围对象，然后将其扩展并重新分配给轴值。

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

使用新数据列更新图表

1 个答案: