Excel VBA如何扩展关联Record表A列的图表数据线并调整X轴范围

首先修正原代码的语法问题：Option Explicit 必须放在代码模块的最顶部，不能写在过程内部。你需要的扩展数据线逻辑已补充到下方完整代码中：

Option Explicit ' 移到模块最顶部

Private Sub Workbook_Open()
    Dim ws As Worksheet, cht As ChartObject, dt As Date
    Dim myLastRow As Long, myRow As Long ' 改用Long避免行号溢出
    Dim ser As Series, formulaParts As Variant, xAddress As String
    
    With Sheets("Record")
        ' 原逻辑保留，替换Select避免卡顿
        myLastRow = .Cells(.Rows.Count, "H").End(xlUp).Row
        ' 扩展A列日期使最后一条记录为距今一周后，同时扩展预测数据
        myRow = myLastRow
        Do Until .Range("A" & myRow) >= Now() + 7
            myRow = myRow + 1
            .Range("A" & myRow) = .Range("A" & myRow - 1) + 1
            If myRow > myLastRow + 1 Then
                .Range("B" & myRow & ":G" & myRow) = .Range("B" & myRow - 1 & ":G" & myRow - 1).Value
            End If
        Loop
    End With

    dt = Date + 7

    For Each ws In ThisWorkbook.Sheets
        For Each cht In ws.ChartObjects
            cht.Chart.Axes(xlCategory).MaximumScale = dt
            ' 补充遍历数据线逻辑
            For Each ser In cht.Chart.SeriesCollection
                ' 拆分系列公式提取X轴数据源地址
                formulaParts = Split(ser.Formula, ",")
                If UBound(formulaParts) >= 1 Then
                    xAddress = formulaParts(1)
                    ' 判断X轴是否来自Record表A列
                    If InStr(1, xAddress, "'Record'!$A:$A", vbTextCompare) > 0 Or _
                       InStr(1, xAddress, "Record!$A:$A", vbTextCompare) > 0 Or _
                       InStr(1, xAddress, "'Record'!$A1:$A", vbTextCompare) > 0 Or _
                       InStr(1, xAddress, "Record!$A1:$A", vbTextCompare) > 0 Then
                        ' 提取Y列的列号和起始行
                        Dim yAddress As String, yCol As String, yStartRow As Long
                        yAddress = formulaParts(2)
                        yCol = Split(Split(yAddress, "$")(2), "$")(0)
                        yStartRow = Split(Split(yAddress, "$")(3), ":")(0)
                        ' 重新赋值X和Y的数据源范围到myRow
                        ser.XValues = "=Record!$A$" & yStartRow & ":$A$" & myRow
                        ser.Values = "=Record!$" & yCol & "$" & yStartRow & ":$" & yCol & "$" & myRow
                    End If
                End If
            Next ser
        Next cht
    Next ws
    ' 原跳转逻辑保留
    Sheets("Record").Select
    Range("D" & myLastRow).Select
End Sub

• 拆分每个图表系列的Formula属性，提取X轴数据源地址，判断是否匹配Record表A列
• 匹配成功后自动提取Y轴对应的列号和起始行，拼接新的数据源范围到之前计算好的myRow行
• 原代码中使用的Integer类型最大仅支持32767行，改用Long类型避免行号溢出
• 替换原代码中的Select操作，大幅提升代码运行效率

内容的提问来源于stack exchange，提问作者RobinClay