数字验证在 VBA 中不起作用

Question

我有一个 VBA 脚本，用于从用户（以表格形式）获取产品名称、数量和价格的输入，如果一切都通过验证，那么它应该将其添加到列出产品的表格的底部.

除了检查数量和价格是否为数字的验证检查外，一切似乎都很好，它似乎总是通过这个检查。

任何帮助都会很棒。谢谢

我在下面复制了我的代码：

Dim strName As String
Dim intResponse, intQuantity, intProdNumber As Integer
Dim intPrice As Currency
Dim wksInventory As Worksheet
Dim wksRange As Range
'Define Variables


Set wksInventory = Application.ActiveWorkbook.Worksheets(2)  'Set to correct worksheet
wksInventory.Select
wksInventory.Columns("A:D").HorizontalAlignment = xlCenter
wksInventory.Range("A2").Select



intProdNumber = 1

strName = txtProduct.Text                    'Assign strName to input in txtProduct text box
intQuantity = Val(txtQuantity.Text)          'Assign intQuantity to input in txtQuantity text box
intPrice = Val(txtPrice.Text)                'Assign intPrice to input in txtPrice text box



Do Until IsEmpty(ActiveCell)
    If intProdNumber <= Val(ActiveCell.Value) Then
        intProdNumber = Val(ActiveCell.Value) + 1
    End If
    ActiveCell.Offset(1, 0).Select
Loop

intResponse = MsgBox("Are you certain of the following:" + vbNewLine + "Product Name: " + strName + vbNewLine + "Quantity: " + CStr(intQuantity) + vbNewLine + "Price: " + CStr(intPrice), vbYesNo)

'Validating Product Name

If Not (Len(strName) = 0) Then    'Check that strName isn't empty
    If Not (IsNumeric(strName)) Then    'Check that it is not a number
        'Do Nothing - Maintain value of intResponse
    Else
        MsgBox ("Product Name should not be a number")
        intResponse = 0                 'Set intResponse to value different than vbYes
    End If
Else
    MsgBox ("Product Name is empty")
    intResponse = 0           'Set intResponse to value different than vbYes
End If

'Validating Quantity
If (intResponse = 6) Then
    If (IsNumeric(intQuantity)) Then
        If (intQuantity > 0) Then
            'Do Nothing
        Else
            MsgBox ("Quantity should be greater than zero")
            intResponse = 0          'Set intResponse to value different than vbYes
        End If
    Else
        MsgBox ("Quantity should be a number")
    End If
End If

'Validating Price

If (intResponse = 6) Then
    If (IsNumeric(intPrice)) Then
        If (intPrice > 0) Then
            'Do nothing
        Else
            MsgBox ("Price should be greater than zero")
            intResponse = 0          'Set intResponse to value different than vbYes
        End If
    Else
        MsgBox ("Price should be a number")
    End If
End If



If intResponse = vbYes Then
    ActiveCell.Value = intProdNumber
    ActiveCell.Offset(0, 1) = txtProduct.Text
    ActiveCell.Offset(0, 2) = CStr(intQuantity)
    ActiveCell.Offset(0, 3) = "$" + CStr(Round(intPrice, 2))
    txtProduct.Text = ""
    txtQuantity.Text = ""
    txtPrice.Text = ""

    'Unload (frmNewProduct)
    'frmInitial.Show

End If

Answer 1

如果你愿意，你可以把它放在你的命令按钮中，但是使用 Textbox.change 也可以节省你的时间，例如。

Private Sub CommandButton1_Click()
    Range("B1") = Me.TextBox1.Value
    Unload Me
End Sub

Private Sub TextBox1_Change()
    If IsNumeric(Me.TextBox1) Then
    Else
        With Me.TextBox1
            .SelStart = 0
            .SelLength = Len(.Text)
            .SetFocus
        End With
        MsgBox "Must be a number"
    End If
    If Me.TextBox1 > 0 Then
    Else
        With Me.TextBox1
            .SelStart = 0
            .SelLength = Len(.Text)
            .SetFocus
        End With
        MsgBox "Must be  > 0"
    End If
End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Me.TextBox1 = Format(Me.TextBox1, "$#,##0.00")
End Sub

Answer 2

您应该在显示消息框后退出子或函数。
如果您正在使用 Sub，请使用“退出 Sub”；如果您正在使用 Function，请使用“退出功能”。

例如

'Validating Price

If (intResponse = 6) Then
    If (IsNumeric(intPrice)) Then
        If (intPrice > 0) Then
            'Do nothing
        Else
            MsgBox ("Price should be greater than zero")
            intResponse = 0          'Set intResponse to value different than vbYes
            Exit Sub
        End If
    Else
        MsgBox ("Price should be a number")
        Exit Sub
    End If
End If

Answer 3

对于项目的最佳架构有各种各样的看法，我的意见只是个人意见。所以，FWIW，我会在UserForm 事件中处理数据验证——这样用户就不会努力输入他的所有数据，只是发现点击了“做”按钮，他又回到了正方形一。

我想你的UserForm 上有几个TextBoxes 和某种“执行”按钮（称为“保存”或“输入”或类似的东西）。在验证所有数据之前禁用该按钮可能会更好，这样单击就可以确定启动。在下面的代码中，有一个示例说明您如何做到这一点 - 一旦输入有效，它就会将 TextBox 的背景绘制为绿色，但您可以弹出消息或任何您喜欢的内容。在验证方面，我确实喜欢RegEx，即使是数字字符串，因为我可以轻松控制某些东西的小数位数（这对于货币价值等很有用）。不过，许多人会不同意这种方法。

就您的代码而言，我在下面粘贴了一个示例，说明获取产品 ID 和填充工作表的方法比每次都选择单元格更简单（尽可能避免使用 Select 和 Activate）。正如pnuts 所说，请注意您的声明 - 如果您要保持对数据类型的控制，每个声明都必须有自己的类型标识符。例如，在您的代码中，您似乎希望数量为 Integer，但尚未将其声明为 1。而在 VBA 中，Strings 与 & 连接。

要使下面的代码正常工作，您需要引用 RegEx。转到工具 -> 参考...并单击 Microsoft VBScript Regular Expressions 5.5 处的复选框。

在您的UserForm 中输入以下代码，显然要根据需要更改控件名称：

Private Const RED As Long = &HC0C0FF
Private Const GREEN As Long = &H80FF80
Private mPriceIsValid As Boolean
Private mQuantityIsValid As Boolean
Private mProductIsValid As Boolean

Private Property Let PriceIsValid(value As Boolean)
    mPriceIsValid = value
    txtPrice.BackColor = IIf(value, GREEN, RED)
    btnProcess.Enabled = mPriceIsValid And mQuantityIsValid And mProductIsValid
End Property
Private Property Let QuantityIsValid(value As Boolean)
    mQuantityIsValid = value
    txtQuantity.BackColor = IIf(value, GREEN, RED)
    btnProcess.Enabled = mPriceIsValid And mQuantityIsValid And mProductIsValid
End Property
Private Property Let ProductIsValid(value As Boolean)
    mProductIsValid = value
    txtProduct.BackColor = IIf(value, GREEN, RED)
    btnProcess.Enabled = mPriceIsValid And mQuantityIsValid And mProductIsValid
End Property

Private Sub btnProcess_Click()
    ProcessInputs txtProduct.Text, txtQuantity.Text, txtPrice.Text
    txtProduct.Text = ""
    txtPrice.Text = ""
    txtQuantity.Text = ""
End Sub

Private Sub txtPrice_Change()
    If Not IsPositiveCurrency(txtPrice.Text) Then
        PriceIsValid = False
    ElseIf val(txtPrice.Text) = 0 Then
        PriceIsValid = False
    Else
        PriceIsValid = True
    End If
End Sub

Private Sub txtProduct_Change()
    ProductIsValid = (Len(txtProduct.Text) <> 0)
End Sub

Private Sub txtQuantity_Change()
    If Not IsPositiveDecimal(txtQuantity.Text, 1) Then
        QuantityIsValid = False
    ElseIf val(txtQuantity.Text) = 0 Then
        QuantityIsValid = False
    Else
        QuantityIsValid = True
    End If

End Sub

Private Function IsPositiveCurrency(textValue As String) As Boolean
    Dim regex As New RegExp

    regex.Pattern = "^\d+(\.\d{2})?$"
    IsPositiveCurrency = regex.Test(textValue)
End Function
Private Function IsPositiveInteger(textValue As String) As Boolean
    Dim regex As New RegExp

    regex.Pattern = "^\d+$"
    IsPositiveInteger = regex.Test(textValue)
End Function
Private Function IsPositiveDecimal(textValue As String, uptoDecPlaces As Integer) As Boolean
    Dim regex As New RegExp

    regex.Pattern = "^\d+(\.\d{1," & CStr(uptoDecPlaces) & "})?$"
    IsPositiveDecimal = regex.Test(textValue)
End Function

Private Sub UserForm_Initialize()
    ProductIsValid = False
    QuantityIsValid = False
    PriceIsValid = False
End Sub

然后在您的Module 中粘贴以下代码：

Public Sub ProcessInputs(product As String, quantity As String, price As String)
    Const PRODUCT_ID_COL As String = "A"
    Const PRODUCT_ID_FIRST_ROW As Long = 2
    Dim wksInventory As Worksheet
    Dim nextRow As Range
    Dim id As Long
    Dim dialogResult As Integer

    dialogResult = MsgBox("Are you certain of the following:" & vbCrLf & vbCrLf & _
                          "Product Name: " & product & vbCrLf & _
                          "Quantity: " & quantity & vbCrLf & _
                          "Price: " & price, vbYesNo)

    If dialogResult = vbYes Then

        'Find the next blank row
        Set wksInventory = ThisWorkbook.Worksheets(2)
        Set nextRow = wksInventory.Cells(wksInventory.Rows.Count, PRODUCT_ID_COL).End(xlUp).Offset(1)

        'Acquire the next product ID
        If nextRow.Row < PRODUCT_ID_FIRST_ROW Or nextRow.Row = 1 Then
            MsgBox "Headers missing!"
            End
        ElseIf nextRow.Row = PRODUCT_ID_FIRST_ROW Then
            id = 1
        ElseIf Not IsNumeric(nextRow.Offset(-1).Value2) Then
            MsgBox "Product number corrupt!"
            End
        Else
            id = nextRow.Offset(-1).Value2 + 1
        End If

        'Populate and format the new row
        nextRow.Resize(, 4).value = Array(id, product, quantity, price)
        nextRow.Resize(, 4).HorizontalAlignment = xlCenter
        nextRow.Offset(, 3).NumberFormat = "[$$-409]#,##0.00_ ;[Red]-[$$-409]#,##0.00 "

    End If
End Sub