如何通过VBA在用户窗体保存前检查地址多列重复数据

我有一个存储地址数据的表格，通过用户窗体录入AddressID、LastName、FirstName、ZipCode、City字段。点击保存按钮时，希望在写入shAdress表格前，检查除AddressID外的录入地址是否已存在。之前用的是先写入表格再检查去重的方式，现在需要优化为先检查再写入的实现方案。

示例表格 #

原有写入后去重的VBA代码 #

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

    '关闭计算、屏幕更新和事件
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    With wksTab
        .Activate
        
        '获取待检查的行列数
        LastRow = .Range(TableName).Rows.Count
        LastCol = Range(TableName).Columns.Count
        
        '构造排除ID列的字段数组（列数随表格变化）
        ReDim vardat(0 To LastCol - 2) As Variant
        
        For i = 2 To LastCol
            vardat(i - 2) = i
        Next i
        
        '删除重复记录，对比排除ID列的字段
        ActiveSheet.ListObjects(TableName).DataBodyRange.RemoveDuplicates Columns:=(vardat), Header:=xlYes
        
        '获取去重后的行数
        LastRowNew = .Range(TableName).Rows.Count
    End With
    
    '恢复计算、屏幕更新和事件
    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 "数据已写入表格"
    Else
        MsgBox "数据已存在"
    End If
End Sub

优化方案：先检查再写入 #

核心检查函数 #

这个函数会对比用户窗体录入的LastName、FirstName、ZipCode、City四个字段，判断是否在目标表格中已存在：

Function IsAddressDuplicate(wksTab As Worksheet, TableName As String, lastName As String, firstName As String, zipCode As String, city As String) As Boolean
    Dim tbl As ListObject
    Dim rngData As Range
    Dim arrData As Variant
    Dim i As Long
    
    '关闭不必要的功能提升效率
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    
    Set tbl = wksTab.ListObjects(TableName)
    '如果表格无数据，直接返回无重复
    If tbl.DataBodyRange Is Nothing Then
        IsAddressDuplicate = False
        GoTo Cleanup
    End If
    
    arrData = tbl.DataBodyRange.Value
    
    '遍历表格数据，对比关键字段
    For i = 1 To UBound(arrData)
        '对比LastName、FirstName、ZipCode、City（对应表格第2到5列）
        If arrData(i, 2) = lastName And _
           arrData(i, 3) = firstName And _
           arrData(i, 4) = zipCode And _
           arrData(i, 5) = city Then
            IsAddressDuplicate = True
            GoTo Cleanup
        End If
    Next i
    
    '未找到重复
    IsAddressDuplicate = False

Cleanup:
    '恢复系统设置
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Function

用户窗体保存按钮示例代码 #

在用户窗体的保存按钮点击事件中调用上述检查函数，只有无重复时才写入数据：

Private Sub cmdSave_Click()
    Dim newRow As ListRow
    Dim lastNameVal As String
    Dim firstNameVal As String
    Dim zipCodeVal As String
    Dim cityVal As String
    Dim addressIDVal As String
    
    '获取用户窗体输入的值
    addressIDVal = Me.txtAddressID.Value
    lastNameVal = Me.txtLastName.Value
    firstNameVal = Me.txtFirstName.Value
    zipCodeVal = Me.txtZipCode.Value
    cityVal = Me.txtCity.Value
    
    '检查是否存在重复地址
    If IsAddressDuplicate(shAdress, "tbAdressen", lastNameVal, firstNameVal, zipCodeVal, cityVal) Then
        MsgBox "该地址已存在，无需重复录入！", vbExclamation
        Exit Sub
    End If
    
    '无重复则写入新行
    Set newRow = shAdress.ListObjects("tbAdressen").ListRows.Add
    newRow.Range(1) = addressIDVal
    newRow.Range(2) = lastNameVal
    newRow.Range(3) = firstNameVal
    newRow.Range(4) = zipCodeVal
    newRow.Range(5) = cityVal
    
    MsgBox "地址已成功保存！", vbInformation
    '清空窗体输入
    Me.txtAddressID.Value = ""
    Me.txtLastName.Value = ""
    Me.txtFirstName.Value = ""
    Me.txtZipCode.Value = ""
    Me.txtCity.Value = ""
End Sub

方案优势 #

• 避免无效写入：提前拦截重复数据，不需要写入后再删除，减少表格操作
• 效率更高：仅遍历一次现有数据，无需执行去重操作
• 反馈更及时：用户输入后立即告知是否重复，提升交互体验

内容的提问来源于stack exchange，提问作者Karl-Heinz