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

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).Column
    
  • Preserves 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.
  • 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

  1. Replace "Data" in Set wsData = ThisWorkbook.Worksheets("Data") with your actual data sheet name.
  2. 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
  3. 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

相关产品推荐
方舟 Agent Plan

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

最近更新时间:2026.05.07 21:32:27