VBA拆分卡车数据至工作表并生成图表报错求助

1. 修复语法错误导致的运行终止 #

• 代码中SetReport = Worksheets(SplitItem.Value).ChartObjects.Add(...)是语法错误，应改为Set Report = Worksheets(SplitItem.Value).ChartObjects.Add(Left:=100, Width:=375, Top:=50, Height:=225)（补充Set关键字和正确的位置参数，与新建工作表时的图表创建逻辑保持一致）
• 所有End(Down)需修正为End(xlDown)，缺少xl前缀会触发运行时错误

2. 修正图表数据源的指向错误 #

• 初始定义的i和j是基于原活动工作表的固定范围，拆分后每个工作表的数据源应基于当前工作表的实际数据：
  • 替换Set graphRange = NewWs.Range("C2").End(xlToRight).End(xlDown)为：

    Dim lastRow As Long, lastCol As Long
    lastRow = NewWs.Cells(NewWs.Rows.Count, "C").End(xlDown).Row
    lastCol = NewWs.Cells(1, NewWs.Columns.Count).End(xlToLeft).Column
    Set graphRange = NewWs.Range("C1", NewWs.Cells(lastRow, lastCol))
    

    （包含表头，确保图表能正确识别系列名称）
  • 已存在工作表的图表数据源，同样要基于当前工作表的实际数据，而非原工作表的固定范围

3. 避免依赖ActiveChart，直接引用目标图表对象 #

• 原代码中ActiveChart.FullSeriesCollection(...)容易因为活动对象变化而出错，改为直接用Report.Chart.FullSeriesCollection(...)，示例：

  Report.Chart.FullSeriesCollection(1).Name = "pH"
  Report.Chart.FullSeriesCollection(1).Values = NewWs.Range("D2:D" & lastRow)
  

4. 避免重复创建图表 #

• 当工作表已存在时，无需每次复制数据都新建图表：
  • 检查该工作表是否已有图表，若有则更新数据源；若无再创建
  • 或仅在新建工作表时创建图表，后续只更新数据和图表的数据源

5. 优化数据复制的可靠性 #

• 原代码Range(SplitItem.End(xlToLeft), SplitItem.End(xlToLeft).End(xlToRight)).Copy如果行内有空单元格，会导致复制不完整，改为使用表头的列数确定复制范围：

  SplitWs.Cells(SplitItem.Row, Hdgs.Column).Resize(1, Hdgs.Columns.Count).Copy _
  Destination:=Worksheets(SplitItem.Value).Range("A1").End(xlDown).Offset(1, 0)
  

6. 排除拆分列的表头 #

• 遍历SplitFld时，确保不包含表头行，若用户选择的拆分列包含表头，从第2行开始遍历：

  For Each SplitItem In SplitFld.Offset(1, 0).Resize(SplitFld.Rows.Count - 1, 1)
  

优化后的核心代码片段示例 #

新建工作表时的图表创建部分 #

Else '工作表不存在时创建新表
    Set NewWs = Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    NewWs.Name = SplitItem.Value
    Hdgs.Copy Destination:=NewWs.Range("A1")
    '复制当前行数据
    SplitWs.Cells(SplitItem.Row, Hdgs.Column).Resize(1, Hdgs.Columns.Count).Copy Destination:=NewWs.Range("A2")
    
    '定义图表数据源（包含表头）
    Dim lastRow As Long, lastCol As Long
    lastRow = NewWs.Cells(NewWs.Rows.Count, "C").End(xlDown).Row
    lastCol = NewWs.Cells(1, NewWs.Columns.Count).End(xlToLeft).Column
    Set graphRange = NewWs.Range("C1", NewWs.Cells(lastRow, lastCol))
    
    '创建图表
    Set Report = NewWs.ChartObjects.Add(Left:=100, Width:=375, Top:=50, Height:=225)
    With Report.Chart
        .SetSourceData Source:=graphRange
        .ChartType = xlLineMarkers
        .FullSeriesCollection(1).Name = "pH"
        .FullSeriesCollection(1).Values = NewWs.Range("D2:D" & lastRow)
        .FullSeriesCollection(2).Name = "RA"
        .FullSeriesCollection(2).Values = NewWs.Range("E2:E" & lastRow)
        .FullSeriesCollection(2).XValues = NewWs.Range("C2:C" & lastRow)
    End With
End If

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