You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

VBA动态更新Excel图表数据范围遇1004错误求助

动态设置图表数据范围的VBA错误修复方案

问题背景

尝试解决该问题2天仍未找到合适方案:现有VBA代码中使用boltRange.End(xlDown)设置图表Series的Values和XValues时触发1004应用定义或对象定义错误;静态范围(如"G2:G999")可正常运行,但无法适配动态变化的样本量。需求是根据样本量动态更新图表数据范围,实现按指定列向下获取最后有效数据的动态范围设置。

原代码

Private Sub Update()

    Worksheets("PBF_Graphs").Activate
    
    ThisWorkbook.Worksheets("PBF_Graphs").Unprotect Password:="test"
    
    Dim lastRow As Range
    Dim modelSheet As String
    Dim currentModel As String
    Dim boltNo As Integer
    Dim boltRange As Range
    Dim BSN_Range As Range
    Dim chart As ChartObject
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim chartName As String
    Dim graphNo As Integer
    Dim chartNo As String
    Dim ch As String
    Dim i As Integer
    Dim j As Integer
    Dim currentFixing As String

    Set wb = ActiveWorkbook
    Set ws = wb.ActiveSheet
    Set lastRow = Range("C2")
    Set BSN_Range = Range("$C$2")
    chartNo = "Chart "
    
    Const fixing1 = "$G$1"
    Const fixing2 = "$I$1"
    Const fixing3 = "$K$1"
    Const fixing4 = "$M$1"
    
    currentFixing = "$G$1"
    
    ' set up bolt number as 1 for incrementation always start from FP-FB and finish a RP-RB
    boltNo = 1
    Set boltRange = Range("G2")
    
    
    currentModel = MainMenu.globalModel
    
    ' set current model name
    Select Case currentModel
    Case "Model1"
        modelSheet = "DP025"
        graphNo = 3
        j = 3
    Case "Model2"
        modelSheet = "DP025_2"
        graphNo = 7
        j = 7
    Case "Model3"
        modelSheet = "DP025_3"
        graphNo = 11
        j = 11
    Case "Model4"
        modelSheet = "DP025_4"
        graphNo = 16
        j = 16
    End Select
    
    For i = graphNo To graphNo + 3
    
    ' this will automatically change the chart
    ws.ChartObjects(chartNo & j).Activate
    ActiveChart.SeriesCollection(1).Select
    Application.CutCopyMode = False
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.FullSeriesCollection(1).Name = modelSheet & currentFixing
    ActiveChart.FullSeriesCollection(1).values = modelSheet & "!" & boltRange.End(xlDown) ' <- doesn't work gives 1004 error
    ' ActiveChart.FullSeriesCollection(1).values = modelSheet & "!" & "G2:G999" <- works but is not dynamic and if there are blanks it will show in chart
    ActiveChart.FullSeriesCollection(1).XValues = modelSheet & BSN_Range.End(xlDown) ' <- doesn't work either
    
    j = j + 1
    
    incrementRange boltNo, boltRange, currentFixing
    
    
    Next i
                         
        
    ThisWorkbook.Worksheets("PBF_Graphs").Protect Password:="test"

End Sub

Function incrementRange(ByVal bNumber As Integer, bRange As Range, cFixing As String)

    bNumber = bNumber + 1
    
    Select Case bNumber
    Case 1
        Set bRange = Range("$G$2")
        cFixing = "$G$1"
    Case 2
        Set bRange = Range("$I$2")
        cFixing = "$I$1"
    Case 3
        Set bRange = Range("$K$2")
        cFixing = "$K$1"
    Case 4
        Set bRange = Range("$M$2")
        cFixing = "$M$1"
    End Select

End Function

问题分析

  1. 动态范围拼接错误:boltRange.End(xlDown)返回的是Range对象,直接与字符串拼接时,VBA无法生成图表系列所需的标准地址格式(如Sheet!A1:A10),且仅取了结束单元格,未包含起始到结束的完整数据范围。
  2. 参数传递失效:incrementRange函数中bNumber使用ByVal传递,修改后的值无法同步回主程序;bRange和cFixing的修改也未正确作用到主程序变量,导致循环中无法切换到正确的数据列。
  3. 激活/选择操作风险:依赖Activate和Select操作对象,容易因工作表切换触发错误,且代码效率较低。

解决方案

1. 正确构建动态数据范围

通过Resize方法计算从起始单元格到最后有效单元格的行数,生成完整的地址字符串:

' 构建Values的动态范围
valuesRange = modelSheet & "!" & boltRange.Resize(boltRange.End(xlDown).Row - boltRange.Row + 1).Address

' 构建XValues的动态范围
xValuesRange = modelSheet & "!" & BSN_Range.Resize(BSN_Range.End(xlDown).Row - BSN_Range.Row + 1).Address

2. 修复参数传递逻辑

将incrementRange改为Sub过程,使用ByRef传递参数,确保主程序变量能被正确更新,同时指定工作表对象避免范围错误:

Sub incrementRange(ByRef bNumber As Integer, ByRef bRange As Range, ByRef cFixing As String, ws As Worksheet)
    bNumber = bNumber + 1
    ' 超过4个螺栓后重置为1
    If bNumber > 4 Then bNumber = 1
    
    Select Case bNumber
    Case 1
        Set bRange = ws.Range("$G$2")
        cFixing = "$G$1"
    Case 2
        Set bRange = ws.Range("$I$2")
        cFixing = "$I$1"
    Case 3
        Set bRange = ws.Range("$K$2")
        cFixing = "$K$1"
    Case 4
        Set bRange = ws.Range("$M$2")
        cFixing = "$M$1"
    End Select
End Sub

3. 优化对象操作方式

避免使用Activate和Select,直接通过对象引用操作图表,提升代码稳定性:

Dim targetChart As ChartObject
Set targetChart = wsGraphs.ChartObjects(chartNo & j)

With targetChart.Chart
    .SeriesCollection.NewSeries
    With .FullSeriesCollection(1)
        .Name = wsModel.Range(currentFixing).Value
        .Values = valuesRange
        .XValues = xValuesRange
    End With
End With

修改后的完整代码

Private Sub Update()
    Dim wsGraphs As Worksheet
    Set wsGraphs = ThisWorkbook.Worksheets("PBF_Graphs")
    
    wsGraphs.Unprotect Password:="test"
    
    Dim modelSheet As String
    Dim currentModel As String
    Dim boltNo As Integer
    Dim boltRange As Range
    Dim BSN_Range As Range
    Dim wb As Workbook
    Dim graphNo As Integer
    Dim chartNo As String
    Dim i As Integer
    Dim j As Integer
    Dim currentFixing As String
    Dim valuesRange As String
    Dim xValuesRange As String
    Dim targetChart As ChartObject
    Dim wsModel As Worksheet

    Set wb = ThisWorkbook
    currentModel = MainMenu.globalModel
    
    ' 设置当前模型对应的工作表和起始图表编号
    Select Case currentModel
    Case "Model1"
        modelSheet = "DP025"
        graphNo = 3
        j = 3
    Case "Model2"
        modelSheet = "DP025_2"
        graphNo = 7
        j = 7
    Case "Model3"
        modelSheet = "DP025_3"
        graphNo = 11
        j = 11
    Case "Model4"
        modelSheet = "DP025_4"
        graphNo = 16
        j = 16
    End Select
    
    Set wsModel = wb.Worksheets(modelSheet)
    Set BSN_Range = wsModel.Range("$C$2")
    chartNo = "Chart "
    
    ' 初始化螺栓编号和数据范围
    boltNo = 1
    Set boltRange = wsModel.Range("$G$2")
    currentFixing = "$G$1"
    
    For i = graphNo To graphNo + 3
        ' 构建动态数据范围
        valuesRange = modelSheet & "!" & boltRange.Resize(boltRange.End(xlDown).Row - boltRange.Row + 1).Address
        xValuesRange = modelSheet & "!" & BSN_Range.Resize(BSN_Range.End(xlDown).Row - BSN_Range.Row + 1).Address
        
        ' 操作目标图表
        Set targetChart = wsGraphs.ChartObjects(chartNo & j)
        With targetChart.Chart
            .SeriesCollection.NewSeries
            With .FullSeriesCollection(1)
                .Name = wsModel.Range(currentFixing).Value
                .Values = valuesRange
                .XValues = xValuesRange
            End With
        End With
        
        j = j + 1
        ' 更新螺栓编号和数据范围
        incrementRange boltNo, boltRange, currentFixing, wsModel
    Next i
                         
    wsGraphs.Protect Password:="test"
End Sub

Sub incrementRange(ByRef bNumber As Integer, ByRef bRange As Range, ByRef cFixing As String, ws As Worksheet)
    bNumber = bNumber + 1
    ' 超过4个螺栓后重置为1
    If bNumber > 4 Then bNumber = 1
    
    Select Case bNumber
    Case 1
        Set bRange = ws.Range("$G$2")
        cFixing = "$G$1"
    Case 2
        Set bRange = ws.Range("$I$2")
        cFixing = "$I$1"
    Case 3
        Set bRange = ws.Range("$K$2")
        cFixing = "$K$1"
    Case 4
        Set bRange = ws.Range("$M$2")
        cFixing = "$M$1"
    End Select
End Sub

内容的提问来源于stack exchange,提问作者Jaymar

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.08.17 07:31:20