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
问题分析
- 动态范围拼接错误:
boltRange.End(xlDown)返回的是Range对象,直接与字符串拼接时,VBA无法生成图表系列所需的标准地址格式(如Sheet!A1:A10),且仅取了结束单元格,未包含起始到结束的完整数据范围。 - 参数传递失效:
incrementRange函数中bNumber使用ByVal传递,修改后的值无法同步回主程序;bRange和cFixing的修改也未正确作用到主程序变量,导致循环中无法切换到正确的数据列。 - 激活/选择操作风险:依赖
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
相关产品推荐
相关产品推荐

