查找 Excel Table 中 x 值的重复行

Question

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

我创建了一个函数，如果具有 Value1 和 Value2 的记录已在同一行中注册，则 return 为布尔值，以防止重复。

这是我面临的问题：我实际上正在对 3 个值匹配执行相同的函数

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

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

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 构建数据库，遗憾的是这并不真正符合我的需求，因为我存储的数据几乎没有“逻辑 link”，而且完全不同。

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

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

查找 Excel Table 中 x 值的重复行

Finding duplicates Rows in Excel Table for x values

database

excel

search

vba

duplicates