Excel VBA多列合并/转置问题：循环写入数据被覆盖

需求与现有问题 #

需要处理类透视表样式的Excel数据：

• 从H列开始，截止到'Total Activity Costs'前的Visit列数据
• 仅保留对应行值为1的记录，将相关信息复制到BuiltCosts工作表
• 部分数据硬编码，部分来自其他工作表

现有VBA代码存在问题：每次循环处理Visit列时，新数据会覆盖BuiltCosts中之前写入的内容，已知问题出在p=2的起始设置，但无法解决。

问题分析 #

原代码的核心问题：

1. 每次遍历Visit列时，都从p=2开始写入BuiltCosts，导致新的Visit列数据直接覆盖旧数据
2. 没有判断源数据行中当前Visit列的值是否为1，不符合需求
3. 动态列取值的逻辑未实现，无法对应到当前循环的Visit列

修正后的VBA代码 #

With ActiveSheet
    Dim lrrg As Range
    Set lrrg = .Range("A1").CurrentRegion ' 明确引用With块的工作表，避免歧义

    Dim lastColumn As Long, lastRow As Long
    Dim p As Long, destRow As Long ' destRow跟踪BuiltCosts的写入行号
    Dim VisitRange As Range, Visit As Range

    ' 获取源数据最后一行行号（从行2开始遍历）
    lastRow = lrrg.Rows(lrrg.Rows.Count).Row
    ' 获取第5行的最后一列，再偏移-5得到目标列的终点
    lastColumn = .Cells(5, .Columns.Count).End(xlToLeft).Column

    ' 定义Visit列范围：第5行H列到倒数第5列
    Set VisitRange = .Range(.Cells(5, 8), .Cells(5, lastColumn).Offset(0, -5))

    ' 初始化目标工作表写入行号，从第2行开始
    destRow = 2

    For Each Visit In VisitRange
        If Visit.Value <> "" Then
            ' 遍历源数据行（从行2到最后一行）
            For p = 2 To lastRow
                ' 判断当前行的Visit列值是否为1，符合条件才写入
                If .Cells(p, Visit.Column).Value = 1 Then
                    With Sheets("BuiltCosts")
                        .Cells(destRow, 1) = Worksheets("Front_Page").Range("D8")
                        .Cells(destRow, 2) = Worksheets("Front_Page").Range("D22") & Worksheets("Front_Page").Range("G14") & " " & .Parent.Range("C1") & " " & Visit.Value
                        .Cells(destRow, 3) = "Participant"
                        .Cells(destRow, 6) = .Parent.Cells(p, 1) & " " & .Parent.Cells(p, 5)
                        .Cells(destRow, 8) = "Research Cost"
                        .Cells(destRow, 11) = .Parent.Cells(p, 3)
                        .Cells(destRow, 13) = .Parent.Cells(p, 6)
                        ' 动态获取当前Visit列的对应行值
                        .Cells(destRow, 14) = .Parent.Cells(p, Visit.Column)
                    End With
                    ' 写入后目标行号自增，避免覆盖
                    destRow = destRow + 1
                End If
            Next p
        End If
    Next Visit
End With

关键改动说明 #

• 新增destRow变量：独立跟踪BuiltCosts工作表的写入行号，每次写入后自增，彻底解决覆盖问题
• 增加判断条件：只有当源数据行中当前Visit列的值为1时，才执行写入操作，符合需求
• 动态列取值：用Visit.Column获取当前循环的Visit列号，实现对应行值的动态读取
• 明确工作表引用：所有Range操作都通过With块明确归属，避免ActiveSheet的歧义问题
• 修正lastRow计算：去掉多余的+1，确保遍历到源数据的最后一行

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