VBA数组未读取全部数据 跨表首列匹配循环遍历异常排查

代码无法遍历数组全量数据由2个核心逻辑错误导致：

• 加载Sheet2数据到data数组时，错误使用主表ws1B列的最后行号定义Sheet2的数据范围，而非调用ws2自身的有效数据行号，最终生成的数组行数和Sheet2真实数据行数不匹配，直接导致数据被截断
• 主表循环终止行使用Range("A2").End(xlDown)写法，只要主表A列存在空单元格，循环会在第一个空行位置提前终止，无法覆盖全部主表记录
• 额外性能缺陷：循环过程中逐单元格读写工作表对象，数据量超过千行时运行速度会明显变慢。

Sub Summarize()
    Dim i As Long, n As Long
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim data, mainData, lastRow1 As Long, lastRow2 As Long
    
    Application.ScreenUpdating = False
    
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    
    ' 从列底部向上定位最后一行有效数据，规避中间空单元格的影响
    lastRow1 = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
    lastRow2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row
    
    ' 两个表数据全部加载到内存数组，避免逐单元格读表的性能损耗
    data = ws2.Range("A2:G" & lastRow2).Value
    mainData = ws1.Range("A2:J" & lastRow1).Value
    
    ' 遍历主表记录
    For n = 1 To UBound(mainData, 1)
        ' 遍历数据表做匹配
        For i = 1 To UBound(data, 1)
            If mainData(n, 1) = data(i, 1) Then
                ' 内存中完成字符串拼接
                mainData(n, 10) = mainData(n, 10) & " " & data(i, 2) & ","
            End If
        Next
    Next
    
    ' 处理完成的数据一次性写回工作表
    ws1.Range("A2:J" & lastRow1).Value = mainData
    
    Application.ScreenUpdating = True
End Sub

• 所有最后行计算统一使用Cells(rows.count, 列号).End(xlUp).Row写法，不受列中间空单元格干扰，能准确定位到列末尾的有效数据
• 加载data数组时改用ws2自身A列计算Sheet2的有效数据范围，保证数组行数和Sheet2实际数据完全一致，不会出现遍历不全的问题
• 主表待写入区域同步读入数组，所有匹配、拼接操作都在内存中完成，最后一次性写回表格，运行速度比逐单元格读写高几十到上百倍
• 显式声明所有变量类型，避免隐式类型转换带来的意外逻辑错误

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