我如何才能确保根据用户输入正确设定散射图的数据区域?
原标题：How can I ensure that the data ranges for the scatter plots are correctly set based on the user input?
I am working on a VBA project in Excel where I need to create scatter plots dynamically based on user input. The data is stored in a table, and the ranges for the scatter plots need to be determined dynamically. I have a script that generates a table based on user input. The table includes multiple series of data. I need to create three different scatter plots from this table, with the ranges for each plot determined by the user input. There are two different routines: one for building the table and another for creating the graphs.
Here s the table:
I ve tried export the endRow value from the for loop with the numSeries to a dictionary and exporting it. However, the exporting it somehow always get the wrong ranges no matter how I try. I am expecting it to be printing out 3 different graphs with X amount of series (based on user input).
Here are the relevant VBA procedures I have so far: Routine 1: Build the Table
Dim seriesEndRows() As Long
Sub MainProcedure()
Call AskForInput
Call StoreEndRows
Call MakeAllGraphs
End Sub
Sub AskForInput()
User input and table generation code...
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 Initialize the series index
ReDim seriesEndRows(1 To numVariables * numSeries) Adjust size as needed
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 = "" Find end of series
seriesEndRow = seriesEndRow + 1
Loop
seriesEndRow = seriesEndRow - 1
seriesEndRows(seriesIndex) = seriesEndRow Store the end row
seriesIndex = seriesIndex + 1
startRow = seriesEndRow + 1
Next K
Next i
End Sub
Routine 2: Creating the Graphs
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")
Loop to create 3 graphs
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
问题回答
I might approach it something like this:
Sub MakeAllGraphs()
Dim wsControl As Worksheet
Dim chartObj As ChartObject
Dim i As Integer, ttl As String, xcol, ycol
Dim seriesEndRow As Long
Dim seriesIndex As Integer, col As Collection, rng As Range
Set wsControl = ThisWorkbook.Sheets("Control")
Set col = GetDataRanges() get data blocks
wsControl.DrawingObjects.Delete delete existing plots
For i = 1 To 3
assign title, x values column, y values column
Select Case i
Case 1
ttl = "Buckle vs RDI"
xcol = "D"
ycol = "K"
Case 2
ttl = "RDI vs Growth"
xcol = "D"
ycol = "J"
Case 3
ttl = "RDI vs Flange Avg"
xcol = "D"
ycol = "H"
End Select
Set chartObj = wsControl.ChartObjects.Add(Left:=100, Width:=375, _
Top:=50 + (i - 1) * 300, Height:=225)
With chartObj.Chart
.ChartType = xlXYScatterLines
.HasTitle = True
.ChartTitle.Text = ttl
For Each rng In col
With .SeriesCollection.NewSeries
.XValues = rng.Columns(xcol)
.Values = rng.Columns(ycol)
.Name = rng.Cells(1).Value & ":" & rng.Cells(2).Value
End With
Next rng
End With
Next i
End Sub
return a collection of ranges, where each range is a block
of rows representing a series variable
Function GetDataRanges() As Collection
Const START_ROW As Long = 2
Dim col As New Collection, ws As Worksheet, lr As Long
Dim c As Range, m
Set ws = ThisWorkbook.Worksheets("Control")
lr = ws.Cells(Rows.Count, "A").End(xlUp).Row last used row
Set c = ws.Cells(START_ROW, "A") starting here
Do
find the next "Max" in Col A
m = Application.Match("Max", c.Offset(1).Resize(100), 0)
If Not IsError(m) Then
col.Add c.EntireRow.Resize(m) add the rows for this block to the collection
Set c = c.Offset(m + 4) skip to next start row
Else
Exit Do no more data
End If
Loop
Set GetDataRanges = col
End Function
