在 Excel 表中查找 x 值的重复行

Question

我实际上是在 Excel 中构建一个数据库，其中工作表是表，列是列，行是记录，目前还挺简单的。

如果 Value1 和 Value2 的记录已经注册在同一行上，我创建了一个返回布尔值的函数，以防止重复。

这是我面临的问题：我实际上正在为 3 个值匹配执行相同的功能

必须有一种方法可以根据数组中的值的数量动态地使其成为可能。但我只是坚持下去。

我有两个值匹配的初始代码

Function checkDuplicate(ws As Worksheet, value1 As Variant, value2 As Variant) As Boolean
    Dim rng As Range
    Dim first As Variant
    
    checkDuplicate= False
    
    If (ws.Name <> "UI" And ws.Name <> "Lists") Then
    
        With ws.Range("A:A")
            Set rng = .Find(value1)
            
            If Not rng Is Nothing Then
                first = rng.Row
                Do
                    If ws.Range("B" & rng.Row).Value = value2 Then
                        checkDuplicate= True
                    End If
                    Set rng = .FindNext(rng)
                Loop While rng.Row <> first
            End If
        End With
    End If
End Function

如果我的英语有点糟糕，或者如果有人因为我搜索时没有找到它而已经帮助另一个人解决同样的问题，我深表歉意。

任何帮助将不胜感激。

Answer 1

如果您正在构建数据库，请考虑使用 SQL

Option Explicit

Sub test()
    MsgBox checkDuplicate(Sheet1, Array(1, "ABC", "2021-01-12"))
End Sub

Function checkDuplicate(ws As Worksheet, ar As Variant) As Boolean
    Dim cn As Object, cmd As Object, rs As Object
    Dim sql As String, arWhere() As String, i As Long
    
    ReDim arWhere(UBound(ar))
    For i = 0 To UBound(ar)
       arWhere(i) = "[" & ws.Cells(1, i + 1) & "] = ?" '
    Next
   
    sql = " SELECT COUNT(*) FROM [" & ws.Name & "$] " & _
          " WHERE " & Join(arWhere, " AND ")
    Debug.Print sql
          
     'Connecting to the Data Source
    Set cn = CreateObject("ADODB.Connection")
    With cn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .ConnectionString = "Data Source=" & ThisWorkbook.FullName & ";" & _
        "Extended Properties=""Excel 12.0 XML;HDR=YES"";"
        .Open
    End With

    Set cmd = CreateObject("ADODB.Command")    
    With cmd
        .ActiveConnection = cn
        .CommandText = sql
        For i = 0 To UBound(ar)
            .Parameters.Append .CreateParameter(CStr(i), 12, 1) ' adVariant
        Next
        Set rs = .Execute(, ar)
    End With
    checkDuplicate = rs(0) > 0
    cn.Close
    
End Function

或者没有 ADODB

Option Explicit

Function checkDuplicate(ws As Worksheet, valuesArray As Variant) As Boolean

    Dim i As Long, n As Long, j As Long, z As Long
    Dim ar
    
    If ws.Name = "Interface" Or ws.Name = "Listes" Then Exit Function
    z = LBound(valuesArray)
    n = UBound(valuesArray) - z + 1
    With ws
        ar = .UsedRange.Columns(1).Resize(, n)
        For i = 1 To UBound(ar)
            j = 1
            Do
                If ar(i, j) <> valuesArray(j + z - 1) Then
                    Exit Do
                End If
                j = j + 1
            Loop While j <= n
            If j > n Then
                checkDuplicate = True
                Exit Function
            End If
        Next
    End With

End Function

Answer 2

感谢您的回答

我已经考虑过使用 SQL 构建数据库，遗憾的是这并不真正符合我的需求，因为我存储的数据几乎没有“逻辑链接”，而且完全不同。

没关系，我想通了，但如果有人知道如何改进它，我觉得这段代码不是很干净，请随时回答！

Function checkDuplicate(ws As Worksheet, valuesArray As Variant) As Boolean
    Dim rng As Range
    Dim first As Variant
    Dim i As Long, j As Long
    Dim elements As Long
    checkDuplicate = False
    
    elements = UBound(valuesArray) - LBound(valuesArray) + 1
    
    If (ws.Name <> "Interface" And ws.Name <> "Listes") Then
    
        With ws.Range("A:A")
            Set rng = .Find(valuesArray(0))
            
            If Not rng Is Nothing Then
                first = rng.Row
                Do
                    i = 1
                    j = 1
                    
                    Do
                        If ws.Cells(i + 1, rng.Row).Value = valuesArray(i) Then
                             i = i + 1
                        Else
                             j = j + 1
                        End If
                    Loop Until i = elements Or j = elements
                    
                    If i = elements Then
                        checkDuplicate = True
                        GoTo leave
                    End If
                    
                    Set rng = .FindNext(rng)
                Loop While rng.Row <> first
            End If
        End With
    End If
leave:
End Function