繁体   English   中英

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

[英]Finding duplicates Rows in Excel Table for x values

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

我做了一个 function 如果 Value1 和 Value2 的记录已经注册在同一行上,则返回 boolean ,以防止重复。

这是我面临的问题:我实际上正在为 3 个值匹配做同样的 Function

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

我有 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

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

任何帮助将不胜感激。

如果您正在构建数据库,请考虑使用 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

感谢您的回答

我已经考虑用 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

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM