求高效Excel脚本：识别A列重复项并复制整行至其他工作表

核心需求 #

• 遍历由第1-5列拼接生成的A列，识别重复项并将对应整行复制到另一工作表
• 现有代码因数据量过大导致Excel冻结，需优化性能，减少公式依赖

优化思路 #

直接操作工作表单元格是性能瓶颈，改用数组读取+字典记录重复项+批量写入的方式，大幅减少与Excel界面的交互次数，适配8万行数据量。

完整VBA代码 #

Sub CopyDuplicateRows()
    Dim srcSheet As Worksheet, destSheet As Worksheet
    Dim lastRow As Long, i As Long, destRow As Long
    Dim dataArr As Variant, key As String
    Dim duplicateDict As Object
    
    ' 设置源工作表和目标工作表名称，按需修改
    Set srcSheet = ThisWorkbook.Worksheets("数据源")
    Set destSheet = ThisWorkbook.Worksheets("重复项")
    Set duplicateDict = CreateObject("Scripting.Dictionary")
    
    ' 清空目标工作表原有数据（保留表头）
    destSheet.Range("A2:" & destSheet.Cells(destSheet.Rows.Count, destSheet.Columns.Count).Address).Clear
    
    ' 读取源表所有数据到数组，提升读取速度
    lastRow = srcSheet.Cells(srcSheet.Rows.Count, "A").End(xlUp).Row
    dataArr = srcSheet.Range("A1:" & srcSheet.Cells(lastRow, 5).Address).Value
    
    ' 第一次遍历：记录所有重复的A列值
    For i = 2 To lastRow ' 跳过表头，从第2行开始
        key = dataArr(i, 1)
        If duplicateDict.Exists(key) Then
            duplicateDict(key) = duplicateDict(key) + 1
        Else
            duplicateDict(key) = 1
        End If
    Next i
    
    ' 第二次遍历：提取所有重复行，写入数组后批量输出
    destRow = 2 ' 目标表从第2行开始写入（保留表头）
    Dim outputArr() As Variant
    ReDim outputArr(1 To lastRow, 1 To 5) ' 按源表列数调整
    
    For i = 2 To lastRow
        key = dataArr(i, 1)
        If duplicateDict(key) > 1 Then
            ' 复制整行数据到输出数组
            For col = 1 To 5
                outputArr(destRow - 1, col) = dataArr(i, col)
            Next col
            destRow = destRow + 1
        End If
    Next i
    
    ' 批量写入目标工作表，仅一次交互
    If destRow > 2 Then
        destSheet.Range("A2:" & destSheet.Cells(destRow - 1, 5).Address).Value = outputArr
    End If
    
    MsgBox "重复项提取完成，共找到" & destRow - 2 & "条重复行"
End Sub

使用说明 #

1. 打开你的Excel文件，按Alt+F11打开VBA编辑器
2. 在左侧工程窗口右键插入模块，将上述代码粘贴进去
3. 修改代码中srcSheet和destSheet的工作表名称，匹配你的表格
4. 按F5运行脚本，或回到Excel界面添加按钮绑定此宏

性能说明 #

• 数组读取：一次性将8万行数据读入内存，避免逐行读取单元格的开销
• 字典去重：O(n)时间复杂度识别重复项，比工作表函数快数倍
• 批量写入：仅一次将结果写入目标表，彻底解决频繁读写导致的冻结问题

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