Excel多工作表复杂重复数据识别与移除方案问询

针对多工作表表头各异、需按字段匹配度识别重复项的需求，以下是两种无需逐个手动设置的高效解决方案：

一、VBA宏（推荐：灵活适配自定义阈值与表头差异） #

该方案可自动遍历所有工作表，排除指定干扰列（如录入日期、时间、唯一ID），按设定的匹配度阈值标记/删除重复项。

操作步骤： #

1. 打开目标Excel文件，按Alt+F11打开VBA编辑器
2. 右键点击左侧工程窗口的当前工作簿→插入→模块
3. 粘贴以下代码，根据需求修改参数：

Sub MarkSimilarDuplicates()
    Dim ws As Worksheet
    Dim lastRow As Long, lastCol As Long
    Dim i As Long, j As Long, matchCount As Long, validColCount As Long
    Dim threshold As Double ' 匹配度阈值（如0.75表示75%字段匹配）
    Dim excludeHeaders As Variant ' 需要排除的干扰表头
    Dim headerArr() As String
    Dim validCols() As Boolean
    
    ' ====== 可修改参数 ======
    threshold = 0.75 ' 调整为你需要的匹配比例（比如15/20=0.75）
    excludeHeaders = Array("录入日期", "录入时间", "唯一标识符") ' 新增/删除干扰表头
    ' ======================
    
    For Each ws In ThisWorkbook.Worksheets
        ' 获取表头行与有效列范围
        lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
        lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
        ReDim headerArr(1 To lastCol)
        ReDim validCols(1 To lastCol) As Boolean
        
        ' 标记有效列（排除干扰表头）
        validColCount = 0
        For j = 1 To lastCol
            headerArr(j) = ws.Cells(1, j).Value
            validCols(j) = Not (UBound(Filter(excludeHeaders, headerArr(j))) >= 0)
            If validCols(j) Then validColCount = validColCount + 1
        Next j
        
        ' 若有效列数为0，跳过当前工作表
        If validColCount = 0 Then GoTo NextSheet
        
        ' 新增"重复标记"列
        ws.Cells(1, lastCol + 1).Value = "重复标记"
        ws.Cells(1, lastCol + 1).Font.Bold = True
        
        ' 遍历行，计算匹配度并标记
        For i = 2 To lastRow
            ' 跳过已标记为重复的行
            If ws.Cells(i, lastCol + 1).Value <> "是" Then
                For j = i + 1 To lastRow
                    matchCount = 0
                    ' 统计有效列中的匹配字段数
                    For k = 1 To lastCol
                        If validCols(k) Then
                            ' 空单元格视为不匹配（可修改：若要视为匹配，改为 ws.Cells(i,k).Value = ws.Cells(j,k).Value Or (IsEmpty(ws.Cells(i,k)) And IsEmpty(ws.Cells(j,k)))）
                            If ws.Cells(i, k).Value = ws.Cells(j, k).Value Then
                                matchCount = matchCount + 1
                            End If
                        End If
                    Next k
                    ' 判断是否达到阈值
                    If matchCount / validColCount >= threshold Then
                        ws.Cells(j, lastCol + 1).Value = "是"
                    End If
                Next j
            End If
        Next i
NextSheet:
    Next ws
    MsgBox "重复标记完成！"
End Sub

4. 按F5运行宏，完成后每个工作表会新增一列“重复标记”，标记为“是”的即为符合阈值的重复项，可批量筛选删除。

自定义调整说明： #

• 修改threshold值：比如需要15/20列匹配，设为0.75；需要12/18列匹配，设为0.67
• 修改excludeHeaders数组：添加或删除不需要参与匹配的表头（如“录入人”等）
• 空单元格匹配逻辑：代码中默认空单元格视为不匹配，若需要将两行同一列都为空视为匹配，可注释掉原判断行，启用注释中的逻辑。

二、Power Query方案（适合无代码基础用户） #

该方案通过Power Query的批量处理能力，实现跨工作表的相似度匹配：

1. 点击「数据」选项卡→「获取数据」→「自文件」→「自工作簿」，选择目标文件，导入所有工作表
2. 在Power Query编辑器中，点击「主页」→「追加查询」→「将查询追加为新查询」，选择所有导入的工作表
3. 添加自定义列：点击「添加列」→「自定义列」，输入公式计算每行与其他行的匹配度（示例公式需根据表头调整，核心是统计匹配字段数占有效字段数的比例）
4. 筛选出匹配度≥阈值的行，标记后加载回Excel，再根据标记批量处理原工作表的重复项

注意事项： #

• Power Query对表头差异较大的工作表，会自动补全空值，需提前处理无效空列
• 匹配度公式需手动适配有效列，灵活性略低于VBA

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