用户输入数据后立即进行 VBA 数据验证

Question

您好，我收到了此代码，并且有一个功能可以检查用户是否要输入已经存在的发票编号。实际上，此功能仅在整个表单已填写并即将存储在表格中时才会发生，但我希望在用户输入数据后立即进行验证。

这是我的实际代码：

Private Sub CommandButton1_Click()
Dim L As Long
Dim factureWs As Worksheet
Dim rng As Range
Dim thColor As XlThemeColor

If MsgBox("Confirm?", vbYesNo, "Confirming new invoice") = vbNo Then Exit Sub

Set factureWs = Worksheets("FACTURE") '<--| set the worksheet you want to work with

L = GetLastNonEmptyRow(factureWs, "D", 12) + 1 '<--| get passed worksheet first empty row after last non empty one in column "D" from row 12 (included)

If L > 0 Then If Not CheckDuplicate(Me.TextBox2, factureWs.Range("D12:D" & L - 1)) Then Exit Sub '<--| exit if duplicated non accepted by the user

FillRanges factureWs, L '<--| fill worksheet ranges with userfom controls values

With Me
If .OptionButton1 Then
    FormatCell Range("B" & L), xlThemeColorAccent3
ElseIf .OptionButton2 Then
    FormatCell Range("B" & L), xlThemeColorAccent1
ElseIf .OptionButton3 Then
    FormatCell Range("B" & L), xlThemeColorAccent4
Else
    FormatCell Range("B" & L), xlThemeColorAccent2
End If
End With

End Sub

这里是函数

Function CheckDuplicate(factureNo As String, rng As Range) As Boolean
    Dim f As Range
    Set f = rng.Find(what:=factureNo, LookIn:=xlValues, lookat:=xlWhole)
    If Not f Is Nothing Then
        CheckDuplicate = MsgBox("This invoice number already exist!" & vbCrLf & vbCrLf & "Continue?", vbExclamation + vbYesNo, "Duplicate alert") = vbYes
    Else
        CheckDuplicate = True
    End If
End Function

感谢您的帮助！

Answer 1

您可以在用户表单模块中添加以下事件处理程序；

Private Sub TextBox2_Change()
    Dim L As Long
    Dim factureWs As Worksheet

    Set factureWs = Worksheets("FACTURE")
    L = GetLastNonEmptyRow(factureWs, "D", 12) + 1 '<--| get passed worksheet first empty row after last non empty one in column "D" from row 12 (included)
    If L <= 12 Then Exit Sub '<--| exit if no data in worksheet "FACTURE"

    With Me.TextBox2
        If Not CheckDuplicate(.Text, factureWs.Range("D12:D" & L - 1)) Then .Text = Left(.Text, Len(.Text) - 1)  '<--| erase the last character that triggered the duplication issue
    End With
End Sub

我是为TextBox2控件编写的，只需将“TextBox2”更改为您的实际文本框名称

作为附注，由于似乎有多个用户表单子使用factureWs，您可能希望在用户表单级别声明它（并在任何用户表单子/函数中“看到”它）并设置它在用户窗体初始化时：

Option Explicit

Dim factureWs As Worksheet '<--| declare 'factureWs' at the userform level

Private Sub UserForm_Initialize()
    Set factureWs = Worksheets("FACTURE") '<--| set 'factureWs' a the userform initializing
End Sub

...

Private Sub TextBox2_Change()
    Dim L As Long

    L = GetLastNonEmptyRow(factureWs, "D", 12) + 1 '<--| get passed worksheet first empty row after last non empty one in column "D" from row 12 (included)
    If L <= 12 Then Exit Sub '<--| exit if no data in worksheet "FACTURE"

    With Me.TextBox2
        If Not CheckDuplicate(.Text, factureWs.Range("D12:D" & L - 1)) Then .Text = Left(.Text, Len(.Text) - 1)  '<--| erase the last character that triggered the duplication issue
    End With
End Sub

...

Answer 2

您应该使用TextBox2_BeforeUpdate 或TextBox2_Exit。

Change 事件在每个KeyPress 之后更新。例如，如果您有 #Invoice 123 并且您尝试输入新的 #Invoice 1234，则会错误地显示重复消息。

TextBox2_BeforeUpdate 事件

Private Sub TextBox2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    Const msg = "This invoice number already exist!" & vbCrLf & vbCrLf & "Continue?"
    With Worksheets("FACTURE")
        If Not .Range("D12", .Range("D" & .Rows.Count).End(xlUp)).Find(what:=Me.TextBox2, LookIn:=xlValues, lookat:=xlWhole) Is Nothing Then
            If Not MsgBox(msg, vbExclamation + vbYesNo, "Duplicate alert") = vbYes Then
                Me.TextBox2 = ""
            End If
        End If
    End With

End Sub

TextBox2_Exit 事件

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    Const msg = "This invoice number already exist!" & vbCrLf & vbCrLf & "Continue?"
    With Worksheets("FACTURE")
        If Not .Range("D12", .Range("D" & .Rows.Count).End(xlUp)).Find(what:=Me.TextBox2, LookIn:=xlValues, lookat:=xlWhole) Is Nothing Then
            If Not MsgBox(msg, vbExclamation + vbYesNo, "Duplicate alert") = vbYes Then
                Cancel = True
            End If
        End If
    End With

End Sub