在 Excel 或 VBA 中将数字数组与现有记录进行比较

这只是一个玩具示例，但您可以尝试这样的操作，假设每行都按升序排列：

=SUM(--(MMULT(ABS(A2:C2-A$2:C$5),TRANSPOSE(COLUMN(A$2:C$5))^0)=0))

无匹配项的示例

如果答案大于 1，则存在重复。

在 Excel 2016 中，您可能需要将其输入数组或使用 Sumproduct。

以下是一个匹配的示例

请尝试下一个代码。根据第一列不匹配的概率，它应该在几秒钟内完成工作：

Sub MatchFirstRowNumber()
 Dim ws As Worksheet, lastR As Long, rng As Range, arr
 Dim i As Long, j As Long, mtch, boolNo As Boolean
 
 Set ws = ActiveSheet
 lastR = ws.Range("A" & ws.rows.count).End(xlUp).row
 Set rng = ws.Range("A2:O" & lastR)
 arr = rng.rows(1).Value2 'place the first row in an array

 For i = 2 To rng.rows.count
    boolNo = True
    For j = 1 To UBound(arr, 2)
      mtch = Application.match(arr(1, j), rng.rows(i), 0)
      If IsError(mtch) Then boolNo = False: Exit For
    Next j
    If boolNo Then MsgBox "Row """ & i + 1 & """ contains the same nubmers as the first one!", vbInformation, "A match has been found"
 Next
End Sub

作为返回，它会发送一条提及匹配行的消息......

该代码可以适应（也）返回具有特定匹配数的行（例如 14...）。

或者它可以记录匹配的行并在最后发送一条消息来提及它们。

请测试后发送一些反馈。

編輯：

下一个版本发送一条枚举所有匹配项的消息：

Sub MatchFirstRowNumbers()
 Dim ws As Worksheet, lastR As Long, rng As Range, arr, arrRow
 Dim i As Long, j As Long, mtch, boolNo As Boolean, strMatches As String
 
 Set ws = ActiveSheet
 lastR = ws.Range("A" & ws.rows.count).End(xlUp).row
 Set rng = ws.Range("A2:O" & lastR)
 arr = rng.rows(1).Value2 'place the first row in an array
 
 strMatches = "The next matching rows have been found:" & vbCrLf
 For i = 2 To rng.rows.count
    boolNo = True
    For j = 1 To UBound(arr, 2)
      mtch = Application.match(arr(1, j), rng.rows(i), 0)
      If IsError(mtch) Then boolNo = False: Exit For
    Next j
    If boolNo Then strMatches = strMatches & "Row " & i + 1 & vbCrLf
 Next
 If strMatches <> "The next matching rows have been found:" & vbCrLf & vbCrLf Then MsgBox strMatches, vbInformation, "All matches"
End Sub

第二次编辑：

下一个版本速度更快。它利用了两个数组可以直接匹配的事实，因此不需要在引用数组元素之间进行迭代：

Sub MatchFirstRowNumbers()
 Dim ws As Worksheet, lastR As Long, rng As Range, arr, arrRow
 Dim i As Long, j As Long, arrMtch, boolNo As Boolean, strMatches As String
 
 Set ws = ActiveSheet
 lastR = ws.Range("A" & ws.rows.count).End(xlUp).row
 Set rng = ws.Range("A2:O" & lastR)
 arr = rng.rows(1).Value2 'place the first row in an array
 
 strMatches = "The next matching rows have been found:" & vbCrLf
 For i = 2 To rng.rows.count
    boolNo = True
    For j = 1 To UBound(arr, 2)
      arrMtch = Application.IfError(Application.match(arr, rng.rows(i).Value, 0), "X")  'it places "|" for not matching elements
      If Not IsError(Application.match("X", arrMtch, 0)) Then boolNo = False: Exit For 'if "X" exists change boolNo value and exist For
    Next j
    If boolNo Then strMatches = strMatches & "Row " & i + 1 & vbCrLf
 Next
 If strMatches <> "The next matching rows have been found:" & vbCrLf & vbCrLf Then MsgBox strMatches, vbInformation, "All matches"
End Sub

感谢您的有趣挑战！虽然您已经接受了答案，但我想看看不使用 VBA 并使用 Excel 2016 来实现此目的的方法：

• 添加带有排序和连接文本的辅助列，遗憾的是需要填充所有行
  =CONCAT(TEXT(SMALL(C2:Q2, COLUMN(C2:Q2) - COLUMN($C$2) + 1), "00"))
• 另一列查找重复项，再次向下填充
  =COUNTIF($S$2:$S$11, S2) > 1
• 使用条件格式突出显示重复的行（不确定这在 Excel 2016 中是否有效 - 我没有测试过）；选择第一行的第一个单元格，使用固定列引用和相对行引用输入上面步骤中的第一个单元格。
  =$T2

指定包含相同整数的行

• 对于每一行，这将R用逗号分隔的列表（至少两个数字）填充列，每个行索引（范围的行）包含相同的 15 个数字。当未找到“匹配”行时，结果单元格将变为空，

• Count/Match不幸的是，在如此大量的比较中，该组合的执行速度非常慢。它花了近 4 分钟才完成 3000 行的任务，以找到唯一一组两行“匹配”的行。

• 样本数据是使用速度较慢但相对容易得出的 MS365 公式生成的：

  =DROP(REDUCE("",SEQUENCE(3000),LAMBDA(rr,r,
      VSTACK(rr,TAKE(SORTBY(SEQUENCE(,25),RANDARRAY(,25)),,15)))),1)
  

  复制并粘贴为值。可以使用快速 VBA 宏进行复制（例如搜索shuffle array）。

Sub TestMatch()
    
    Dim t As Double: t = Timer
    
    Const COLS_COUNT As Long = 15
    Const FIRST_ROW As Long = 2
    Const FIRST_COLUMN As Long = 3
    Const COLUMN_OFFSET As Long = 1
    Const DELIMITER As String = ", "
    
    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim rg As Range: Set rg = ws.Range("A1").CurrentRegion
    
    Dim rCount As Long: rCount = rg.Rows.Count - 1
    
    Dim srg As Range:
    Set srg = rg.Resize(rCount, COLS_COUNT).Offset(FIRST_ROW - 1, FIRST_COLUMN - 1)
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    
    Dim i As Long
    
    For i = 1 To rCount
        dict(i) = Empty
    Next i
    
    Dim srrg As Range, drrg As Range, Count As Long, j As Long
    
    With Application
        For i = 1 To rCount - 1
            If dict.Exists(i) Then
                For j = i + 1 To rCount
                    If dict.Exists(j) Then
                        Count = .Count(.Match(srg.Rows(i), srg.Rows(j), 0))
                        If Count = COLS_COUNT Then
                            If IsEmpty(dict(i)) Then
                                Set dict(i) = CreateObject("Scripting.Dictionary")
                            End If
                            dict(i)(j) = Empty
                            dict.Remove j
                        End If
                    End If
                Next j
            End If
        Next i
    End With
                    
    If dict.Count = rCount Then Exit Sub ' no duplicate rows found
    
    Debug.Print Timer - t
    
    Dim Data() As String: ReDim Data(1 To rCount, 1 To 1)
    
    Dim oKey As Variant, iKey As Variant, rStr As String
    
    For Each oKey In dict.Keys
        If Not IsEmpty(dict(oKey)) Then
            rStr = oKey
            rStr = rStr & DELIMITER & Join(dict(oKey).Keys, DELIMITER)
            Data(oKey, 1) = rStr
            For Each iKey In dict(oKey).Keys
                Data(iKey, 1) = rStr
            Next iKey
        End If
    Next oKey
        
    Dim drg As Range:
    Set drg = srg.Columns(COLS_COUNT).Offset(, COLUMN_OFFSET)
    drg.Value = Data
        
    Debug.Print Timer - t
        
End Sub