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

时间:2016-09-11 05:22:20

标签: forms vba validation duplicates

你好我得到了这个代码,并且有一个功能来检查用户是否要输入已经存在的发票号码。实际上,只有当整个表格已经填写并且即将存储在表格中时才会出现此功能,但我希望在用户输入数据后立即进行验证。

这是我的实际代码:

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

感谢您的帮助!

2 个答案:

答案 0 :(得分:1)

您可以在userform模块中添加以下事件处理程序;

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控件编写的,只需更改&#34; TextBox2&#34;到您的实际文本框名称

作为旁注,因为似乎有多个使用factureWs的用户表单子,您可能希望在用户表单级别声明它(并且在任何用户表单中看到&#34;看到&#34; sub / function)并将其设置为userform初始化:

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

...

答案 1 :(得分:1)

您应该使用TextBox2_BeforeUpdateTextBox2_Exit

ChangeKeyPress事件都会更新。因此,例如,如果您有#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