VBA宏循环粘贴失效：需将Tracker负值对应数据导入Pack Plan指定列

原代码核心问题 #

原代码将SKU、托盘类型、负值的处理拆分为三个独立循环，每次匹配到负值都会让目标行rwDest下移，导致同一数据源的三个字段被粘贴到不同行，完全不符合需求。同时代码存在大量重复逻辑，执行效率低下。

修复思路 #

• 合并每个数据区块的处理逻辑：在同一个循环内完成SKU（B列）、托盘类型（E列）、负值（F列）的写入，避免目标行重复下移
• 严格遵循处理顺序：先完成顶部区块（1-4）的处理，再处理底部区块（5-8），底部数据自动追加到顶部数据下方
• 优化目标行偏移逻辑：仅在处理一条有效数据后，才下移一次目标行
• 提取重复操作到子过程，减少代码冗余，提升可维护性

修复后的代码 #

Sub buildPlan()
    ' 声明变量
    Dim wb As Workbook, nwb As Workbook
    Dim wsAPP As Worksheet, wsDNDR As Worksheet
    Dim rwDest As Range, rw As Range
    Dim checkVal As Variant
    
    ' 设置当前工作簿及目标工作表（改用ThisWorkbook更可靠，避免激活其他工作簿出错）
    Set wb = ThisWorkbook
    Set wsAPP = wb.Worksheets("Arils Pack Plan ") ' 注意表名末尾空格
    
    ' 打开Tracker文件
    With Application.FileDialog(msoFileDialogOpen)
        .Filters.Clear
        .Filters.Add "Excel文件", "*.xlsx; *.xlsm; *.xlsa"
        .AllowMultiSelect = False
        If .Show = -1 Then ' 判断是否选择了文件
            Set nwb = Application.Workbooks.Open(.SelectedItems(1))
            Set wsDNDR = nwb.Worksheets("DAILY NEED (DR)")
        Else
            MsgBox "未选择文件，宏已终止"
            Exit Sub
        End If
    End With
    
    ' 设置结果起始行
    Set rwDest = wsAPP.Rows(7)
    
    ' ---------------------- 处理顶部区块（1-4） ----------------------
    ' 1. 4oz Day1 (Q5:Q14)
    ProcessBlock wsDNDR, "Q5:Q14", rwDest
    ' 2. 4oz Day2 (T5:T14)
    ProcessBlock wsDNDR, "T5:T14", rwDest
    ' 3. 8oz Day1 (Q15:Q26)
    ProcessBlock wsDNDR, "Q15:Q26", rwDest
    ' 4. 8oz Day2 (T15:T26)
    ProcessBlock wsDNDR, "T15:T26", rwDest
    
    ' ---------------------- 处理底部区块（5-8） ----------------------
    ' 以下为示例范围，需根据实际业务调整对应区域
    ' 5. 底部区块1（示例：Q27:Q36）
    ' ProcessBlock wsDNDR, "Q27:Q36", rwDest
    ' 6. 底部区块2（示例：T27:T36）
    ' ProcessBlock wsDNDR, "T27:T36", rwDest
    ' 7. 底部区块3（示例：Q37:Q48）
    ' ProcessBlock wsDNDR, "Q37:Q48", rwDest
    ' 8. 底部区块4（示例：T37:T48）
    ' ProcessBlock wsDNDR, "T37:T48", rwDest
    
    MsgBox "Pack Plan生成完成"
    nwb.Close SaveChanges:=False ' 关闭Tracker文件，不保存修改
End Sub

' 子过程：处理单个数据区块，提取负值对应的数据到目标工作表
Private Sub ProcessBlock(ByVal wsSource As Worksheet, ByVal rangeAddr As String, ByRef destRow As Range)
    Dim rw As Range
    Dim checkVal As Variant
    
    For Each rw In wsSource.Range(rangeAddr).Rows
        checkVal = rw.Value ' 获取当前行的检查值（Q/T列的值）
        If checkVal < 0 Then
            ' 写入SKU到B列
            destRow.Columns("B").Value = rw.EntireRow.Columns("B").Value
            ' 写入托盘类型到E列
            destRow.Columns("E").Value = rw.EntireRow.Columns("E").Value
            ' 写入负值到F列
            destRow.Columns("F").Value = checkVal
            ' 目标行下移一行，准备下一条数据
            Set destRow = destRow.Offset(1)
        End If
    Next rw
End Sub

关键改动说明 #

1. 合并循环逻辑：新增ProcessBlock子过程，在单个循环内完成三个字段的写入，确保同一数据源的三个值在同一行
2. 修正目标行偏移：仅当处理有效数据时才下移目标行，避免空行或数据错位
3. 增强可靠性：改用ThisWorkbook指代宏所在工作簿，增加文件选择判断，避免未选文件时出现错误
4. 结构清晰化：分区块标注代码，顶部和底部区块分开处理，便于后续调整数据范围
5. 资源优化：处理完成后自动关闭源文件，避免占用Excel资源

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