Excel VBA多列数据自动生成指定XY散点图问题求助

我需要用VBA自动生成独立散点图：X轴固定用B列数据，Y轴选用列号符合公式5*c+4的列（比如D列、I列这类，要分别生成B vs D、B vs I的独立图表）。但我写的代码生成的是单张图表里包含多系列，不是多个独立图表，求修改方法。

原代码 #

Dim FC As Integer
Dim Columncount As Integer
Columncount = Cells(1, Columns.Count).End(xlToLeft).Column

FC = 0
For j = 2 To Columncount
    For c = 0 To 10
        If j <> FC Then
        FC = (5 * c + 4)
        Else
        FC = FC
        If j = FC Then
            With ActiveSheet.Shapes.AddChart.Chart
            .ChartType = xlXYScatter
            .SeriesCollection.NewSeries
                With .SeriesCollection(1)
                .Name = "=" & ActiveSheet.Name & "!" & _
                Cells(1, j).Address
                .XValues = "=" & ActiveSheet.Name & "!" & _
                Range(Cells(2, 2), Cells(5500, 2)).Address
                .Values = "=" & ActiveSheet.Name & "!" & _
                Range(Cells(2, j), Cells(5500, j)).Address
                End With
            .HasLegend = False
            End With
            Else
            End If
            End If
    Next c
Next j

End Sub

修改后的代码 #

原代码核心问题是循环逻辑混乱，且错误地在同一个图表里重复添加系列。下面的代码会直接遍历符合条件的列，每列生成一个独立图表：

Sub CreateIndependentCharts()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim c As Integer
    Dim targetCol As Integer
    Dim chartObj As ChartObject
    
    ' 指定操作的工作表，避免依赖ActiveSheet的不确定性
    Set ws = ThisWorkbook.ActiveSheet
    ' 动态获取B列最后一行数据行号，替代固定的5500行
    lastRow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
    
    ' 循环生成符合5*c+4的列号，直到列号超过表格最大列数
    c = 0
    Do
        targetCol = 5 * c + 4
        ' 检查目标列是否存在于当前表格中
        If targetCol > ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column Then
            Exit Do
        End If
        
        ' 创建新的独立图表对象，设置位置和大小（每列图表横向错开）
        Set chartObj = ws.ChartObjects.Add(Left:=100 + c * 200, Top:=50, Width:=300, Height:=200)
        With chartObj.Chart
            .ChartType = xlXYScatter
            ' 清除图表默认自带的系列，避免干扰
            Do While .SeriesCollection.Count > 0
                .SeriesCollection(1).Delete
            Loop
            ' 添加当前Y列的系列数据
            With .SeriesCollection.NewSeries
                .Name = ws.Cells(1, targetCol).Value
                .XValues = ws.Range(ws.Cells(2, 2), ws.Cells(lastRow, 2))
                .Values = ws.Range(ws.Cells(2, targetCol), ws.Cells(lastRow, targetCol))
            End With
            .HasLegend = True ' 保留图例，方便识别对应的数据列
            .ChartTitle.Text = "B列 vs " & ws.Cells(1, targetCol).Value ' 添加图表标题，一目了然
        End With
        
        c = c + 1
    Loop
End Sub

关键调整说明 #

• 直接通过Do Loop生成符合5*c+4的列号，抛弃原代码嵌套循环的混乱逻辑，精准定位目标列
• 每次创建ChartObject独立图表对象，确保每个Y列对应一张单独的图表
• 用lastRow动态获取数据行数，适配不同的数据量，比固定5500行更灵活
• 给每个图表添加标题，方便快速识别对应的Y列
• 清除图表默认系列，避免多余的空系列干扰图表显示

内容的提问来源于stack exchange，提问作者Miguel Fliman