VBA跨工作表循环汇总数据：空行定位与变量累加错误修复咨询

嘿，我来帮你搞定这个汇总数据的问题！你的代码思路没问题，但变量累加的逻辑出错了，而且还有更可靠的方法来定位Summary的空行。咱们逐个问题说：

问题1：更直接定位Summary下一行空行的方法 #

最稳妥且常用的方式是利用Excel的End(xlUp)方法，它能快速找到指定列最后一个非空单元格的行号，再加1就是下一个空行的位置。比如针对A列：

Dim nextEmptyRow As Long
nextEmptyRow = wb.Sheets("Summary").Range("A" & wb.Sheets("Summary").Rows.Count).End(xlUp).Row + 1

这个方法的好处是不受手动修改Summary表数据的影响，哪怕你手动在Summary里加了内容，它也能准确找到下一个空行，比靠变量累加更可靠。

问题2：正确累加变量获取准确值的方法 #

你的原代码里lrowsum = zz是错误的——它把当前工作表的总行数赋值给了lrowsum，而不是实际写入到Summary的行数。正确的逻辑应该是：

• 初始化lrowsum为Summary表当前已有的行数（或者用上面的nextEmptyRow初始值）
• 每当找到符合条件的行并写入后，就把lrowsum加1（或者更新nextEmptyRow）

两种实现思路：

思路1：用变量累加写入的行数 #

' 初始化lrowsum为Summary的最后一行非空行号+1
lrowsum = wb.Sheets("Summary").Range("A" & wb.Sheets("Summary").Rows.Count).End(xlUp).Row + 1

For Each ws In wb.Worksheets
    If ws.Name <> "Summary" Then
        For zz = 1 To ws.UsedRange.Rows.Count
            If InStr(ws.Range("A" & zz).Value, "C") > 0 Or InStr(ws.Range("A" & zz).Value, "O") > 0 Then
                ' 写入数据
                wb.Sheets("Summary").Cells(lrowsum, 1) = ws.Cells(zz, 1)
                wb.Sheets("Summary").Cells(lrowsum, 2) = ws.Cells(zz, 2)
                ' 累加行号，准备下一次写入
                lrowsum = lrowsum + 1
            End If
        Next zz
    End If
Next ws

思路2：每次写入后重新获取空行位置（更稳妥，适合复杂场景） #

如果你担心Summary表在运行过程中被其他操作修改，可以每次写入前都重新获取下一个空行：

For Each ws In wb.Worksheets
    If ws.Name <> "Summary" Then
        For zz = 1 To ws.UsedRange.Rows.Count
            If InStr(ws.Range("A" & zz).Value, "C") > 0 Or InStr(ws.Range("A" & zz).Value, "O") > 0 Then
                Dim nextRow As Long
                nextRow = wb.Sheets("Summary").Range("A" & wb.Sheets("Summary").Rows.Count).End(xlUp).Row + 1
                wb.Sheets("Summary").Cells(nextRow, 1) = ws.Cells(zz, 1)
                wb.Sheets("Summary").Cells(nextRow, 2) = ws.Cells(zz, 2)
            End If
        Next zz
    End If
Next ws

修正后的完整代码 #

结合优化速度的设置，最终代码如下：

Option Explicit
Sub Source_Cleaner()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim zz As Long, lrowsum As Long ' 用Long避免行号超出Integer范围
    Dim summaryWs As Worksheet ' 提前定义Summary工作表，减少重复调用
    
    Set wb = ThisWorkbook
    Set summaryWs = wb.Sheets("Summary") ' 缓存Summary表对象
    
    'Optimize Macro Speed Start
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    ' 初始化lrowsum为Summary的下一个空行
    lrowsum = summaryWs.Range("A" & summaryWs.Rows.Count).End(xlUp).Row + 1
    
    For Each ws In wb.Worksheets
        If ws.Name <> "Summary" Then
            For zz = 1 To ws.UsedRange.Rows.Count
                ' 合并条件，简化代码
                If InStr(ws.Cells(zz, "A").Value, "C") > 0 Or InStr(ws.Cells(zz, "A").Value, "O") > 0 Then
                    ' 写入数据
                    summaryWs.Cells(lrowsum, "A") = ws.Cells(zz, "A")
                    summaryWs.Cells(lrowsum, "B") = ws.Cells(zz, "B")
                    ' 累加行号
                    lrowsum = lrowsum + 1
                End If
            Next zz
        End If
    Next ws
    
    'Optimize Macro Speed End
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
End Sub

额外优化点： #

• 把Summary工作表提前赋值给变量summaryWs，减少重复调用wb.Sheets("Summary")，提升运行速度
• 把条件合并成Or，简化代码
• 用Long类型存储行号，因为Excel的行号可能超过Integer的最大值（32767）

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