如何用Excel公式或VBA实现3k+行无序数字序列查重？

因为判断重复的核心是数字集合一致即视为重复，所以可以先将每行的数字排序后拼接成唯一标识字符串，再统计该字符串的出现次数：

1. 假设数据存放在A1:O3000区域，在P1单元格输入以下公式，下拉填充至所有行，生成每行的排序后标识字符串：

=TEXTJOIN(",", TRUE, SORT(A1:O1))

2. 在Q1单元格输入公式，判断当前行是否重复：

=IF(COUNTIF($P:$P, P1) > 1, "重复", "唯一")

旧版本Excel兼容方案（无SORT/TEXTJOIN函数） #

若使用Excel 2019及更早版本，可通过数组公式生成排序后的字符串（输入后按Ctrl+Shift+Enter确认）：

=CONCATENATE(SMALL(A1:O1,1),",",SMALL(A1:O1,2),",",SMALL(A1:O1,3),",",SMALL(A1:O1,4),",",SMALL(A1:O1,5),",",SMALL(A1:O1,6),",",SMALL(A1:O1,7),",",SMALL(A1:O1,8),",",SMALL(A1:O1,9),",",SMALL(A1:O1,10),",",SMALL(A1:O1,11),",",SMALL(A1:O1,12),",",SMALL(A1:O1,13),",",SMALL(A1:O1,14),",",SMALL(A1:O1,15))

之后同样用COUNTIF统计重复次数。

对于3000行的数据集，VBA的处理效率远高于公式，以下代码会自动在P列标记每行是否重复：

Sub CheckDuplicateDraws()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim dataRange As Range
    Dim rowArr As Variant
    Dim sortedArr As Variant
    Dim keyStr As String
    Dim dict As Object
    Dim i As Long
    
    ' 指定目标工作表，可改为Sheets("你的工作表名")
    Set ws = ActiveSheet
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Set dataRange = ws.Range("A1:O" & lastRow)
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' 遍历所有行，记录每个数字组合的出现行号
    For i = 1 To lastRow
        rowArr = dataRange.Rows(i).Value
        sortedArr = SortArray(rowArr)
        keyStr = Join(sortedArr, ",")
        
        If dict.Exists(keyStr) Then
            dict(keyStr) = dict(keyStr) & "," & i
        Else
            dict(keyStr) = CStr(i)
        End If
    Next i
    
    ' 标记重复行
    For i = 1 To lastRow
        rowArr = dataRange.Rows(i).Value
        sortedArr = SortArray(rowArr)
        keyStr = Join(sortedArr, ",")
        
        ws.Cells(i, "P").Value = IIf(UBound(Split(dict(keyStr), ",")) > 0, "重复", "唯一")
    Next i
    
    MsgBox "重复检查完成！"
End Sub

' 辅助函数：对一维数组进行升序排序
Function SortArray(arr As Variant) As Variant
    Dim temp As Variant
    Dim i As Long, j As Long
    
    ' 将二维行数组转为一维
    If UBound(arr) > 1 Then arr = Application.Transpose(arr)
    
    ' 冒泡排序
    For i = LBound(arr) To UBound(arr) - 1
        For j = i + 1 To UBound(arr)
            If arr(i) > arr(j) Then
                temp = arr(i)
                arr(i) = arr(j)
                arr(j) = temp
            End If
        Next j
    Next i
    
    SortArray = arr
End Function

使用步骤： #

1. 按下Alt+F11打开VBA编辑器；
2. 右键点击左侧工程窗口的工作表，选择「插入」→「模块」；
3. 将上述代码粘贴到模块窗口中；
4. 按下F5运行宏，或回到Excel界面通过「开发工具」→「宏」执行CheckDuplicateDraws。

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