如何为未知行数的VBA宏实现逐行循环？

你的宏目前仅处理第31行的固定数据，要实现逐行循环处理，咱们可以用For Next循环遍历目标行范围，同时去掉代码里冗余的Select/Activate操作（这能大幅提升代码的稳定性和效率）。

修改后的完整代码 #

Sub loopplannercomments()
    ' gather planner comments for each line
    Dim srcWB As Workbook
    Dim srcWS As Worksheet
    Dim pivotWB As Workbook
    Dim pivotWS As Worksheet
    Dim pt As PivotTable
    Dim lastRow As Long
    Dim i As Long
    
    ' 提前定义工作簿/工作表对象，避免反复切换窗口
    Set srcWB = ThisWorkbook ' 假设宏保存在SPV Schedule那个工作簿里
    Set srcWS = srcWB.Worksheets("你的源工作表名称") ' 替换成实际的源表名称
    Set pivotWB = Workbooks("BP Tool Notes for Missing Material 12.27.xlsm")
    Set pivotWS = pivotWB.Worksheets("透视表所在工作表名") ' 替换成透视表所在的工作表名
    Set pt = pivotWS.PivotTables("PivotTable1")
    
    ' 获取I列最后一行有数据的行号，确定循环的结束位置
    lastRow = srcWS.Cells(srcWS.Rows.Count, "I").End(xlUp).Row
    
    ' 从第31行开始，逐行循环到最后一行
    For i = 31 To lastRow
        ' 1. 获取当前行的零件号
        Dim partNum As String
        partNum = srcWS.Cells(i, "I").Value
        
        ' 2. 操作透视表筛选对应零件号
        pt.PivotFields("sod_part").ClearAllFilters
        pt.PivotFields("sod_part").CurrentPage = partNum
        
        ' 3. 处理F10到G10，移除空括号
        pivotWS.Range("F10").Copy
        pivotWS.Range("G10").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        pivotWS.Range("G10").Replace What:="(  )", Replacement:="", LookAt:=xlPart
        
        ' 4. 处理G15到H15，把结果粘贴回源表O列对应行
        pivotWS.Range("G15").Copy
        pivotWS.Range("H15").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        pivotWS.Range("H15").Copy srcWS.Cells(i, "O")
        
        ' 清除复制状态
        Application.CutCopyMode = False
    Next i
End Sub

关键修改点说明 #

• 对象化操作：提前定义好源工作簿、透视表工作簿等对象，不用每次切换窗口激活，避免因窗口切换导致的错误，代码运行也更快。
• 动态循环范围：通过lastRow获取I列最后一行有数据的行，确保循环覆盖所有需要处理的行，不用硬编码结束行号。
• 循环变量替换：用i作为行号变量，把原代码里固定的31替换成i，实现逐行处理每一行的数据。
• 去掉冗余选中操作：直接通过对象引用复制粘贴，不用先选中单元格，代码更简洁可靠。

额外注意事项 #

1. 务必把代码里的**"你的源工作表名称"和"透视表所在工作表名"**替换成实际的工作表名称，不然代码会报错。
2. 如果透视表中找不到某个零件号，会触发错误。可以添加错误处理跳过这类行：

' 在设置CurrentPage前添加
On Error Resume Next
pt.PivotFields("sod_part").CurrentPage = partNum
On Error GoTo 0
' 检查是否筛选成功，失败则标记后跳过当前行
If pt.PivotFields("sod_part").CurrentPage <> partNum Then
    srcWS.Cells(i, "O").Value = "未找到对应零件"
    GoTo SkipToNextRow
End If

' ... 后续处理代码 ...

SkipToNextRow:

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