VBA实现用户窗体文本框更新后检测重复记录并提示单元格位置

原有代码问题说明 #

• 函数使用错误：CountIf仅支持单区域单条件匹配，无法同时校验B、C、D三列的三个匹配条件，需使用多条件计数函数CountIfs，且参数格式不符合要求
• 缺少匹配位置定位逻辑：原有代码仅能判断是否存在重复，无法返回对应记录的单元格位置
• 未做日期格式校验：文本框输入的出生日期为字符串格式，直接和D列日期类型数据匹配会出现类型不匹配问题

修改后可运行代码 #

Private Sub TextBox3_AfterUpdate()
    Dim ws As Worksheet
    Dim matchRow As Long
    Dim inputDob As Date
    
    ' 校验出生日期输入合法性
    On Error Resume Next
    inputDob = CDate(TextBox3.Text)
    If Err.Number <> 0 Then
        MsgBox "请输入合法的出生日期，示例：2000/1/1", vbExclamation, "输入错误"
        TextBox3.SetFocus
        Exit Sub
    End If
    On Error GoTo 0
    
    ' 替换为你实际存储数据的工作表名称
    Set ws = ThisWorkbook.Worksheets("数据记录表")
    
    ' 多条件校验是否存在完全匹配的记录
    If Application.CountIfs( _
        ws.Range("B:B"), TextBox1.Text, _
        ws.Range("C:C"), TextBox2.Text, _
        ws.Range("D:D"), inputDob) > 0 Then
        
        ' 定位匹配记录的行号
        matchRow = Evaluate("MATCH(1,(B:B=""" & TextBox1.Text & """)*(C:C=""" & TextBox2.Text & """)*(D:D=DATE(" & Year(inputDob) & "," & Month(inputDob) & "," & Day(inputDob) & ")),0)")
        MsgBox "该人员已存在，对应记录位于第" & matchRow & "行，单元格范围为B" & matchRow & ":D" & matchRow, vbCritical, "重复记录提醒"
    End If
End Sub

注意事项 #

• 请将代码中的"数据记录表"替换为你实际存储人员信息的工作表名称
• 如果你的数据表第一行为表头，可将匹配范围从整列修改为从第二行开始的有效数据范围，可大幅提升运行效率，例如将ws.Range("B:B")修改为ws.Range("B2:B" & ws.Cells(ws.Rows.Count, "B").End(xlUp).Row)
• 若需要匹配到重复记录后自动跳转到对应行，可在MsgBox代码后增加两行：ws.Activate、ws.Rows(matchRow).Select

内容的提问来源于stack exchange，提问作者Harin