查找Excel表中x值的重复行

23c0lvtd  于 2023-02-17  发布在  其他
关注(0)|答案(2)|浏览(104)

我正在Excel中构建一个数据库,其中工作表是表,列是列,行是记录。
我创建了一个函数,如果Value1和Value2的记录已经在同一行上,则该函数返回一个布尔值,以防止重复。
问题是:
我对三个匹配的值做同样的运算。
必须有一种方法使它根据数组中值的数量动态变化。
有我的初始代码为两个值匹配

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
kd3sttzy

kd3sttzy1#

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

wkyowqbh2#

谢谢你的回答
我已经考虑过用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

相关问题