Excel VBA动态散点图：如何根据用户输入正确设置数据范围？

我正在开发一个Excel VBA项目，需要根据用户输入动态创建3种不同的散点图。数据存储在表格中，散点图的数据范围需动态确定。已经有生成表格的脚本，表格包含多组数据系列，项目分为构建表格和创建图表两个子程序。

表格结构说明 #

表格包含多组连续数据系列，由空行分隔；核心字段列包括：RDI（D列）、Flange Avg（H列）、Growth（J列）、Buckle（K列）。

问题现状 #

尝试通过For循环将各数据系列的结束行（endRow）和系列数量（numSeries）存入数组时，始终获取错误的数据范围。期望最终生成3个图表，每个图表包含对应用户输入数量的多组数据系列。

现有VBA代码 #

子程序1：构建表格（存储系列结束行） #

Dim seriesEndRows() As Long

Sub MainProcedure()
    Call AskForInput
    Call StoreEndRows
    Call MakeAllGraphs
End Sub

Sub AskForInput()
    ' 用户输入及表格生成代码...
End Sub

Sub StoreEndRows()
    Dim wsControl As Worksheet
    Dim i As Integer, K As Integer
    Dim startRow As Long, seriesEndRow As Long
    Dim numSeries As Integer
    Dim seriesIndex As Integer
    
    Set wsControl = ThisWorkbook.Sheets("Control")
    
    startRow = 2
    seriesIndex = 1 ' 初始化系列索引
    ReDim seriesEndRows(1 To numVariables * numSeries) ' 根据需要调整数组大小

    For i = 1 To numVariables
        Dim chkBox As MSForms.CheckBox
        Dim txtBox As MSForms.TextBox
        On Error Resume Next
        Set chkBox = UserForm1.Controls("CheckBox" & i)
        If chkBox Is Nothing Then Exit Sub
        On Error GoTo 0
        
        If chkBox.Value = True Then
            On Error Resume Next
            Set txtBox = UserForm1.Controls("TextBox" & i)
            If txtBox Is Nothing Then Exit Sub
            On Error GoTo 0
            numSeries = Val(txtBox.Text)
        Else
            numSeries = 1
        End If
        
        For K = 1 To numSeries
            seriesEndRow = startRow
            Do Until wsControl.Cells(seriesEndRow, 1).Value = "" ' 查找系列结束行
                seriesEndRow = seriesEndRow + 1
            Loop
            seriesEndRow = seriesEndRow - 1
            
            seriesEndRows(seriesIndex) = seriesEndRow ' 存储结束行
            seriesIndex = seriesIndex + 1
            
            startRow = seriesEndRow + 1
        Next K
    Next i
End Sub

子程序2：创建图表 #

Sub MakeAllGraphs()
    Dim wsControl As Worksheet
    Dim chartObj As ChartObject
    Dim i As Integer
    Dim seriesEndRow As Long
    Dim seriesIndex As Integer
    
    Set wsControl = ThisWorkbook.Sheets("Control")
    
    ' 循环创建3个图表
    seriesIndex = 1
    For i = 1 To 3
        If seriesIndex <= UBound(seriesEndRows) Then
            seriesEndRow = seriesEndRows(seriesIndex)
        Else
            MsgBox "Series index " & seriesIndex & " exceeds array bounds."
            Exit Sub
        End If
        
        Set chartObj = wsControl.ChartObjects.Add(left:=100, width:=375, top:=50 + (i - 1) * 300, height:=225)
        With chartObj.Chart
            .ChartType = xlXYScatterLines
            
            Select Case i
                Case 1 ' Buckle vs RDI
                    .SetSourceData Source:=wsControl.Range("K2:K" & seriesEndRow)
                    .SeriesCollection.NewSeries
                    .SeriesCollection(1).XValues = wsControl.Range("D2:D" & seriesEndRow)
                    .SeriesCollection(1).Values = wsControl.Range("K2:K" & seriesEndRow)
                    .SeriesCollection(1).Name = "Buckle vs RDI"
                
                Case 2 ' RDI vs Growth
                    .SetSourceData Source:=wsControl.Range("J2:J" & seriesEndRow)
                    .SeriesCollection.NewSeries
                    .SeriesCollection(1).XValues = wsControl.Range("D2:D" & seriesEndRow)
                    .SeriesCollection(1).Values = wsControl.Range("J2:J" & seriesEndRow)
                    .SeriesCollection(1).Name = "RDI vs Growth"
                
                Case 3 ' RDI vs Flange Avg
                    .SetSourceData Source:=wsControl.Range("H2:H" & seriesEndRow)
                    .SeriesCollection.NewSeries
                    .SeriesCollection(1).XValues = wsControl.Range("D2:D" & seriesEndRow)
                    .SeriesCollection(1).Values = wsControl.Range("H2:H" & seriesEndRow)
                    .SeriesCollection(1).Name = "RDI vs Flange Avg"
            End Select
            
            .HasTitle = True
            Select Case i
                Case 1
                    .ChartTitle.Text = "Buckle vs RDI"
                Case 2
                    .ChartTitle.Text = "RDI vs Growth"
                Case 3
                    .ChartTitle.Text = "RDI vs Flange Avg"
            End Select
        End With
        
        seriesIndex = seriesIndex + 1
    Next i
End Sub

问题修复方案 #

1. 修复StoreEndRows的数组初始化逻辑 #

原代码中数组初始化时numSeries未赋值，导致数组大小计算错误。需先遍历计算总系列数，再初始化数组：

Sub StoreEndRows()
    Dim wsControl As Worksheet
    Dim i As Integer, K As Integer
    Dim startRow As Long, seriesEndRow As Long
    Dim numSeries As Integer
    Dim seriesIndex As Integer
    Dim totalSeries As Integer ' 新增：计算总系列数
    
    Set wsControl = ThisWorkbook.Sheets("Control")
    
    startRow = 2
    seriesIndex = 1
    totalSeries = 0
    
    ' 第一步：统计总系列数
    For i = 1 To numVariables
        Dim chkBox As MSForms.CheckBox
        Dim txtBox As MSForms.TextBox
        On Error Resume Next
        Set chkBox = UserForm1.Controls("CheckBox" & i)
        If chkBox Is Nothing Then Exit Sub
        On Error GoTo 0
        
        If chkBox.Value = True Then
            On Error Resume Next
            Set txtBox = UserForm1.Controls("TextBox" & i)
            If txtBox Is Nothing Then Exit Sub
            On Error GoTo 0
            totalSeries = totalSeries + Val(txtBox.Text)
        Else
            totalSeries = totalSeries + 1
        End If
    Next i
    
    ' 初始化数组
    ReDim seriesEndRows(1 To totalSeries)
    
    ' 第二步：存储每个系列的结束行
    startRow = 2
    For i = 1 To numVariables
        On Error Resume Next
        Set chkBox = UserForm1.Controls("CheckBox" & i)
        If chkBox Is Nothing Then Exit Sub
        On Error GoTo 0
        
        If chkBox.Value = True Then
            On Error Resume Next
            Set txtBox = UserForm1.Controls("TextBox" & i)
            If txtBox Is Nothing Then Exit Sub
            On Error GoTo 0
            numSeries = Val(txtBox.Text)
        Else
            numSeries = 1
        End If
        
        For K = 1 To numSeries
            ' 改用End(xlDown)高效定位系列结束行
            seriesEndRow = wsControl.Cells(startRow, 1).End(xlDown).Row
            
            seriesEndRows(seriesIndex) = seriesEndRow
            seriesIndex = seriesIndex + 1
            
            startRow = seriesEndRow + 2 ' 空行分隔系列，跳至下一系列起始行
        Next K
    Next i
End Sub

2. 修复MakeAllGraphs的多系列添加逻辑 #

原代码每个图表仅添加1个系列，需循环添加所有对应系列：

Sub MakeAllGraphs()
    Dim wsControl As Worksheet
    Dim chartObj As ChartObject
    Dim i As Integer, seriesCount As Integer
    Dim startRow As Long, endRow As Long
    
    Set wsControl = ThisWorkbook.Sheets("Control")
    
    For i = 1 To 3
        Set chartObj = wsControl.ChartObjects.Add(left:=100, width:=375, top:=50 + (i - 1) * 300, height:=225)
        With chartObj.Chart
            .ChartType = xlXYScatterLines
            .HasTitle = True
            
            ' 设置图表标题
            Select Case i
                Case 1
                    .ChartTitle.Text = "Buckle vs RDI"
                Case 2
                    .ChartTitle.Text = "RDI vs Growth"
                Case 3
                    .ChartTitle.Text = "RDI vs Flange Avg"
            End Select
            
            ' 循环添加所有数据系列
            startRow = 2
            For seriesCount = 1 To UBound(seriesEndRows)
                endRow = seriesEndRows(seriesCount)
                
                .SeriesCollection.NewSeries
                With .SeriesCollection(seriesCount)
                    .XValues = wsControl.Range("D" & startRow & ":D" & endRow)
                    ' 根据图表类型设置Y值列
                    Select Case i
                        Case 1
                            .Values = wsControl.Range("K" & startRow & ":K" & endRow)
                        Case 2
                            .Values = wsControl.Range("J" & startRow & ":J" & endRow)
                        Case 3
                            .Values = wsControl.Range("H" & startRow & ":H" & endRow)
                    End Select
                    .Name = "系列" & seriesCount ' 自定义系列名称
                End With
                
                startRow = endRow + 2 ' 跳至下一系列起始行
            Next seriesCount
        End With
    Next i
End Sub

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