如何用For Each循环遍历Excel ListObject生成对应折线图？

你的代码主要存在几个语法和逻辑问题：循环结构位置错误、子过程无法接收目标表格参数、图表数据源依赖手动选择而非直接绑定ListObject。下面是修正后的完整解决方案：

问题拆解 #

1. 原chart_create过程里的Next tbl写在了End Sub之后，属于语法错误，导致循环根本无法执行；
2. graph子过程没有接收当前遍历的表格对象，而是用Selection作为数据源，这会导致图表数据和目标表格不匹配；
3. 图表位置依赖ActiveCell，会导致所有图表堆叠在一起，无法区分。

修正后的完整代码 #

Sub chart_create()
    Dim tbl As ListObject
    Dim chartTopPosition As Double
    
    ' 初始化第一个图表的垂直起始位置，避免和表格重叠
    chartTopPosition = 10
    
    ' 遍历当前工作表内的所有ListObject
    For Each tbl In ActiveSheet.ListObjects
        ' 将当前表格和目标位置传给生成图表的子过程
        Call graph(tbl, chartTopPosition)
        ' 每次生成图表后，垂直位置下移，避免图表重叠（250是图表高度，20是间距）
        chartTopPosition = chartTopPosition + 270
    Next tbl
End Sub

' 生成折线图的子过程，接收目标表格和位置参数
Sub graph(targetTable As ListObject, topPos As Double)
    Dim newChart As ChartObject
    
    ' 在当前工作表添加图表对象
    Set newChart = ActiveSheet.ChartObjects.Add( _
        Left:=10, _
        Width:=450, _
        Top:=topPos, _
        Height:=250)
    
    ' 直接绑定ListObject的数据区域作为图表数据源
    ' 如果需要包含表头，把DataBodyRange改成Range即可
    newChart.Chart.SetSourceData Source:=targetTable.DataBodyRange
    
    ' 设置图表类型为折线图
    newChart.Chart.ChartType = xlLine
    
    ' 给图表添加标题，用表格名称区分不同图表
    newChart.Chart.ChartTitle.Text = "折线图 - " & targetTable.Name
End Sub

核心要点说明 #

1. 正确遍历ListObject：
   用For Each tbl In ActiveSheet.ListObjects可以精准遍历当前工作表内的所有表格，不会遗漏任何一个；
2. 传递表格参数：
   修改graph子过程让它接收targetTable As ListObject参数，直接把当前遍历的表格传入，彻底摆脱对Selection的依赖；
3. 控制图表位置：
   用chartTopPosition变量控制每个图表的垂直位置，每次生成后下移固定距离，保证所有图表都能清晰展示；
4. 直接引用表格数据：
   targetTable.DataBodyRange会直接获取表格的纯数据区域（不含表头），如果需要包含表头作为图例，替换成targetTable.Range即可。

额外优化建议 #

• 如果想把图表放到单独的工作表，可以把ActiveSheet替换成目标工作表对象，比如ThisWorkbook.Worksheets("图表汇总页")；
• 可以根据表格的列数自动调整折线样式，或者添加坐标轴标签、调整图例位置，让图表更贴合你的展示需求。

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