VBA宏开发:动态选取表格数据生成多组对比散点图
Hey there! Let's get your VBA macro sorted out to create those dynamic scatter plots that adapt to your changing data, plus add the new stress chart without messing up what's already there. Below is a fully functional, flexible macro that handles both your current needs and makes it easy to add more charts later.
Full Working Code
Sub GenerateDynamicScatterPlots() Dim wsData As Worksheet Dim lastRow As Long, lastCol As Long Dim chartDisp As ChartObject, chartStress As ChartObject Dim seriesCol As Long ' Set your data worksheet - update this to match your sheet name! Set wsData = ThisWorkbook.Worksheets("Data") ' Dynamically find the last row (Point No. count) and last column (iterations/parameters) lastRow = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row lastCol = wsData.Cells(1, wsData.Columns.Count).End(xlToLeft).Column ' --- Handle Vertical Displacement vs Coordinate Chart --- ' Check if the chart already exists; if not, create it On Error Resume Next Set chartDisp = wsData.ChartObjects("Disp_vs_Coordinate") On Error GoTo 0 If chartDisp Is Nothing Then ' Create new chart (adjust position/size as needed) Set chartDisp = wsData.ChartObjects.Add(Left:=100, Width:=600, Top:=100, Height:=400) chartDisp.Name = "Disp_vs_Coordinate" With chartDisp.Chart .ChartType = xlXYScatterLines ' Use xlXYScatter for no lines if preferred .HasTitle = True .ChartTitle.Text = "Vertical Displacement vs Vertical Coordinate" .Axes(xlCategory).HasTitle = True .Axes(xlCategory).AxisTitle.Text = "Vertical Coordinate" .Axes(xlValue).HasTitle = True .Axes(xlValue).AxisTitle.Text = "Vertical Displacement" End With Else ' Clear existing series to update with new data Do While chartDisp.Chart.SeriesCollection.Count > 0 chartDisp.Chart.SeriesCollection(1).Delete Loop End If ' Add all displacement series (matches columns with "Displacement" in header) For seriesCol = 1 To lastCol If InStr(LCase(wsData.Cells(1, seriesCol).Value), "displacement") > 0 Then With chartDisp.Chart.SeriesCollection.NewSeries .Name = wsData.Cells(1, seriesCol).Value .XValues = wsData.Range(wsData.Cells(2, 2), wsData.Cells(lastRow, 2)) ' X = Vertical Coordinate (column B) .Values = wsData.Range(wsData.Cells(2, seriesCol), wsData.Cells(lastRow, seriesCol)) ' Y = Displacement data End With End If Next seriesCol ' --- Handle Vertical Stress vs Coordinate Chart --- ' Check if the chart already exists; if not, create it On Error Resume Next Set chartStress = wsData.ChartObjects("Stress_vs_Coordinate") On Error GoTo 0 If chartStress Is Nothing Then ' Place new chart below the displacement chart (adjust position as needed) Set chartStress = wsData.ChartObjects.Add(Left:=100, Width:=600, Top:=chartDisp.Top + chartDisp.Height + 20, Height:=400) chartStress.Name = "Stress_vs_Coordinate" With chartStress.Chart .ChartType = xlXYScatterLines .HasTitle = True .ChartTitle.Text = "Vertical Stress vs Vertical Coordinate" .Axes(xlCategory).HasTitle = True .Axes(xlCategory).AxisTitle.Text = "Vertical Coordinate" .Axes(xlValue).HasTitle = True .Axes(xlValue).AxisTitle.Text = "Vertical Stress" End With Else ' Clear existing series to update with new data Do While chartStress.Chart.SeriesCollection.Count > 0 chartStress.Chart.SeriesCollection(1).Delete Loop End If ' Add all stress series (matches columns with "Stress" in header) For seriesCol = 1 To lastCol If InStr(LCase(wsData.Cells(1, seriesCol).Value), "stress") > 0 Then With chartStress.Chart.SeriesCollection.NewSeries .Name = wsData.Cells(1, seriesCol).Value .XValues = wsData.Range(wsData.Cells(2, 2), wsData.Cells(lastRow, 2)) ' X = Vertical Coordinate (column B) .Values = wsData.Range(wsData.Cells(2, seriesCol), wsData.Cells(lastRow, seriesCol)) ' Y = Stress data End With End If Next seriesCol MsgBox "Charts updated successfully!", vbInformation End Sub
Key Features & Explanations
Dynamic Data Adaptation:
The code automatically finds the last row of Point No.s and last column of data, so it doesn't matter if you add more points or iterations later. This uses:lastRow = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row lastCol = wsData.Cells(1, wsData.Columns.Count).End(xlToLeft).ColumnPreserves Existing Charts:
It checks if a chart already exists by name. If it does, it clears old series and updates with new data instead of creating duplicates. No more messy multiple charts cluttering your sheet!Easy to Add New Charts:
Want to add a "Horizontal Stress vs Vertical Coordinate" chart later? Just copy the stress chart block, modify:- The chart name (e.g.,
"HorizStress_vs_Coordinate") - The chart title and axis labels
- The header keyword check (e.g.,
InStr(..., "horizontal stress"))
That's it—no need to rewrite core logic.
- The chart name (e.g.,
Flexible Series Matching:
Instead of hardcoding column numbers, it uses header text (like "Displacement" or "Stress") to find relevant data columns. This works even if you rearrange your data columns later.
Quick Setup Steps
- Replace
"Data"inSet wsData = ThisWorkbook.Worksheets("Data")with your actual data sheet name. - Make sure your data has:
- Column A: Point No.s
- Column B: Vertical Coordinate values
- Columns with "Displacement" in the header: Your vertical displacement data
- Columns with "Stress" in the header: Your vertical stress data
- Adjust the chart position/size (
Left,Top,Width,Height) if you want them placed differently on the sheet.
Run the macro, and it'll create/update your charts automatically—even if your data grows or changes!
内容的提问来源于stack exchange,提问作者Matcha22

