如何用VBA遍历动态字符串列表并生成汇总工作表？

先修正原代码的核心问题 #

你的代码存在几个关键错误，直接导致无法运行或效率极低：

• 工作表对象赋值必须用Set关键字，原代码里source = Worksheets("Sheet1")会报错
• 遍历整列Range("A:A")会循环100多万行，完全没必要，应该只遍历有数据的单元格
• 计数器逻辑混乱，需要单独维护目标工作表的当前行号，避免行重叠

完整实现代码 #

以下是符合需求的完整代码，附带详细注释：

Sub GenerateReport()
    Dim sourceWs As Worksheet, destWs As Worksheet, dataWs As Worksheet
    Dim sourceRng As Range, cell As Range
    Dim destRow As Long ' 用Long避免行数超过Integer上限（Excel最多1048576行）
    Dim totalVal As Double, aVal As Double, bVal As Double, cVal As Double
    
    ' 初始化工作表对象（必须用Set）
    Set sourceWs = ThisWorkbook.Worksheets("Sheet1") ' 源数据工作表
    Set destWs = ThisWorkbook.Worksheets("Sheet2") ' 目标报表工作表
    Set dataWs = ThisWorkbook.Worksheets("datasheet") ' 存放计算值的工作表
    
    ' 清空目标表原有数据（可选，根据需求调整）
    destWs.Cells.Clear
    ' 写入目标表表头
    destWs.Range("A1:B1").Value = Array("Column A", "Column B")
    
    ' 获取源数据的有效区域（假设源数据从A2开始，A1是表头）
    Set sourceRng = sourceWs.Range("A2:A" & sourceWs.Cells(sourceWs.Rows.Count, "A").End(xlUp).Row)
    
    destRow = 2 ' 目标表从第2行开始写入数据（第1行是表头）
    
    ' 遍历每个源数据项
    For Each cell In sourceRng
        ' 跳过空单元格（避免处理源数据中的空行）
        If cell.Value <> "" Then
            ' 写入源数据到目标表A列
            destWs.Cells(destRow, "A").Value = cell.Value
            
            ' 从datasheet获取计算值（这里替换成你的实际计算逻辑）
            totalVal = dataWs.Cells(cell.Row, "B").Value ' 示例：datasheet的B列对应Total值
            aVal = totalVal ' 示例：a等于Total值
            bVal = totalVal * 0.3 ' 示例：b等于Total*0.3
            cVal = totalVal * 0.7 ' 示例：c等于Total*0.7（可替换成你的逻辑）
            
            ' 写入硬编码的额外行到目标表B列
            destWs.Cells(destRow, "B").Value = totalVal ' Total行
            destWs.Cells(destRow + 1, "B").Value = aVal ' a行
            destWs.Cells(destRow + 2, "B").Value = bVal ' b行
            destWs.Cells(destRow + 3, "B").Value = cVal ' c行
            
            ' 目标行号向后移动4行（当前源项占了4行：Total+3个明细）
            destRow = destRow + 4
        End If
    Next cell
    
    ' 自动调整目标表列宽（可选）
    destWs.Columns("A:B").AutoFit
    
    MsgBox "报表生成完成！", vbInformation
End Sub

关键逻辑说明 #

1. 有效数据范围获取：
   用sourceWs.Cells(sourceWs.Rows.Count, "A").End(xlUp).Row获取A列最后一行有数据的行号，避免遍历整列，大幅提升效率。

2. 目标行号维护：
   用destRow变量跟踪当前要写入的行，每处理完一个源项就加4（因为每个源项对应4行数据），避免行号混乱。

3. 计算值获取：
   代码中totalVal、aVal等的赋值逻辑是示例，你可以根据实际需求替换，比如从datasheet的特定单元格取值，或者直接在代码中计算。

4. 空单元格处理：
   加入If cell.Value <> ""判断，跳过源数据中的空行，避免生成无效的报表行。

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