防止用户表单中多列出现重复条目

Question

我有一张包含地址数据的表格。我通过用户表单输入这些内容。地址 ID、姓氏、名字、邮政编码、城市 当我单击 SaveButton 时，我想检查输入的地址（不带 AddressID ）是否已在 shAdress 表中。 例如

到目前为止，我一直在将数据写入表中，然后检查是否有重复。然而，在切片之前检查数据会更有意义。谁能帮我解决这个问题吗？

地址ID	姓氏	名字	邮政编码	城市
1	五月	保罗	67105	柏林
2	五月	保罗	67106	柏林	没关系
3	五月	保罗	67105	柏林	这是错误的！

我的功能是在插入工作表后进行检查

Function CheckforDuplicateListObject(wksTab As Worksheet, TableName As String) As Boolean

    Dim LastRow As Long, LastRowNew As Long
    Dim LastCol As Long
    Dim i As Long
    Dim vardat() As Variant

    'Switch off calculations
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    With wksTab
        .Activate
        
        'Number of rows and columns to be checked
        LastRow = .Range(TableName).Rows.Count
        LastCol = Range(TableName).Columns.Count
        
        'Form data field without ID column
        'Number of columns varies depending on the table!!!
        ReDim vardat(0 To LastCol - 2) As Variant
        
        For i = 2 To LastCol
            vardat(i - 2) = i
        Next i
        
        'Delete duplicate data records with comparison of the data field
        ActiveSheet.ListObjects(TableName).DataBodyRange.RemoveDuplicates Columns:=(vardat), Header:=xlYes
        
        'Number of remaining lines
        LastRowNew = .Range(TableName).Rows.Count
    End With
    
    ''Berechnungen wieder einschalten
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
    If LastRowNew < LastRow Then
        CheckforDuplicateListObject = True
    Else
        CheckforDuplicateListObject = False
    End If
End Function


Sub testDuplikateListIbjectRows()

    If CheckforDuplicateListObject(shListobj, "tbAdressen") = False Then
        MsgBox "Die Daten wurden in die Tabelle eingetragen"
    Else
        MsgBox "Die Daten sind bereits vorhanden"
    End If
End Sub

Answer 1

假设您有一个足够新的 Excel 版本，那么以下函数会检查重复项

Function existDuplicates(arr As Variant) As Boolean

Dim vDat As Variant
vDat = WorksheetFunction.Unique(arr)

  If UBound(vDat) < UBound(arr) Then
    ' Duplicates Found!
    existDuplicates = True
  Else
    ' No Duplicates Found.
    existDuplicates = False
  End If

End Function

人们可以将其应用到您的情况中

Sub example()

    Dim wks As Worksheet
    Set wks = ActiveSheet

    ' table with the data
    Dim lo As ListObject
    Set lo = wks.ListObjects("Address")

    ' get the data from the table
    Dim rng As Range
    Set rng = lo.DataBodyRange

    ' Only get the columns we need to check for the duplicates
    Set rng = rng.Columns("B:D")
    ' Increase the size by one empty row which gives
    ' the needed space in the array below to add the new record
    Set rng = rng.Resize(rng.Rows.Count + 1)

    ' Example
    Dim vDat As Variant
    vDat = rng.Value2
    Dim lastRow As Long
    lastRow = UBound(vDat)
   
    ' Add the data in question
    vDat(lastRow, 1) = "May"
    vDat(lastRow, 2) = "Paul"
    vDat(lastRow, 3) = 67105
  
    If existDuplicates(vDat) Then
        MsgBox "Duplicates Found!"
    Else
        MsgBox "No Duplicates Found"
    End If

End Sub