问题说明：
- Excel单元格中的数据验证
- 用户只能输入精确的2位小数。所以，11.00，但不是11或11.0
我尝试过的：
INT(A1*100) = A1*100
作为数据验证公式。遗憾的是，它也不允许小数或单小数。
这是我在2011年写的一段代码，用于控制数字的TextBox输入。我更新了它以控制货币数据类型的小数位数。它有点长，因为它涵盖了所有数字数据类型，但您可以将重点放在Currency类型上。请在解释代码操作时阅读注释。当然，你可以使用简短的版本：
Public Function bForceDecimals(zStrValue As Variant, iDecimals As Variant) As Boolean
Dim iDecLoc As Integer
'*** Check for no Decimal ***
iDecLoc = InStr(zStrValue, ".")
If iDecLoc = 0 Then
bForceDecimals = False
Else
If Len(zStrValue) - iDecLoc = iDecimals Then
bForceDecimals = True
Else
bForceDecimals = False
End If
End If
End Function 'bForceDecimals
您可以从Before_Update事件中调用它。
这是为任何感兴趣的人准备的长版本。注意，它并没有像上面的代码那样设置为检查货币小数位数的精确性！
Option Explicit
#Const cModeDebug = False '*** Set to True when debugging & False for Production
' +-------------------------+ +----------+
'-------------------------| bVerifyTextBoxNumber() |-------------| 07/22/20 |
' +-------------------------+ +----------+
'Called by: Any procedure needing to verify numeric input!
'Notes: This routine only verifies numbers NOT DATES!
' If the optional arguments are used for Lower & Upper Limits
' the values passed are considered INVALID entries, i.e. a lower limit of
' Zero will NOT allow a Zero value entry! and an upper limit of 1,000 will
' NOT allow a value greater than 999 for whole numbers and 999.999... for
' Single, Double, and Currency types. If passing only an upper limit you
' must include the commas, i.e.
' --> bVerifyTextBoxNumber(iDatatype,zStrValue,,vUpperLimit)
' Conversion functions, e.g. CInt & CLng round funny...
' If the fractional part is EXACTLY .5 they round to the nearest
' EVEN number, thus; 2.5 rounds to 2 while 3.5 rounds to 4!
' This function, despite it's name can also be used to verify input
' from the INPUTBOX function.
' Decimal placess (vDecimals) are currently only controled on the Currency
' type. If not specified will default to 2 (U.S. standard).
' You can extend the code to other type if desired.
Public Function bVerifyTextBoxNumber(iDataType As Integer, zStrValue As Variant, _
Optional vLowerLimit As Variant, _
Optional vUpperLimit As Variant, _
Optional vDecimals As Variant) As Boolean
Dim bErrNumeric As Boolean
Dim bErrCommas As Boolean
Dim zDatatypes(18) As String
Dim zErrorData As String
zDatatypes(0) = "vbEmpty"
zDatatypes(1) = "vbNull"
zDatatypes(2) = "vbInteger"
zDatatypes(3) = "vbLong"
zDatatypes(4) = "vbSingle"
zDatatypes(5) = "vbDouble"
zDatatypes(6) = "vbCurrency"
zDatatypes(7) = "vbDate"
zDatatypes(8) = "vbString"
zDatatypes(9) = "vbObject"
zDatatypes(10) = "vbError"
zDatatypes(11) = "vbBoolean"
zDatatypes(12) = "Unknown"
zDatatypes(13) = "vbDataObject"
zDatatypes(14) = "vbDecimal"
zDatatypes(15) = "Unknown"
zDatatypes(16) = "Unknown"
zDatatypes(17) = "vbByte"
On Error GoTo ErrorTrap:
bVerifyTextBoxNumber = True
bErrNumeric = False
bErrNumeric = Not IsNumeric(zStrValue)
bErrCommas = InStr(zStrValue, ",") > 0
If bErrNumeric Or bErrCommas Then
bVerifyTextBoxNumber = False
Exit Function
End If
#If cModeDebug Then '*** Construct Debug message ***
zErrorData = "Lower Limit is GREATER than or Equal to Upper Limit!" & _
vbCrLf & vbCrLf & "Data Type Requested: " & vbTab & zDatatypes(iDataType) & _
vbCrLf & "Data Value Passed: " & vbTab & vbTab & zStrValue & vbCrLf & _
"Lower Limit Passed: " & vbTab & vbTab & _
IIf(Not IsMissing(vLowerLimit), vLowerLimit, "None") & vbCrLf & _
"Upper Limit Passed: " & vbTab & vbTab & _
IIf(Not IsMissing(vUpperLimit), vUpperLimit, "None") & vbCrLf & _
"Decimal Places Passed: " & vbTab & vbTab & _
IIf(Not IsMissing(vDecimals), vDecimals, "None")
#End If
Select Case iDataType
Case vbCurrency
'*** Check for no Decimal ***
iDecLoc = InStr(zStrValue, ".")
If iDecLoc = 0 Then
bForceDecimals = True
Return
End If
If IsMissing(vDecimals) Then vDecimals = 2
If Not IsMissing(vLowerLimit) Then
If CCur(zStrValue) <= CCur(vLowerLimit) Then
bVerifyTextBoxNumber = False
End If
End If
If Not IsMissing(vUpperLimit) Then
If CCur(zStrValue) >= CCur(vUpperLimit) Then
bVerifyTextBoxNumber = False
End If
End If
If Len(zStrValue) - InStr(zStrValue, ".") > vDecimals Then
bVerifyTextBoxNumber = False
End If
#If cModeDebug Then
If (Not IsMissing(vLowerLimit)) And _
(Not IsMissing(vUpperLimit)) Then
If CCur(vLowerLimit) >= CCur(vUpperLimit) Then
MsgBox zErrorData, vbOKOnly + vbCritical, _
"bVerifyTextBoxNumber()- Error: Invalid Call to Function"
End If
End If
#End If
Case vbSingle
If Not IsMissing(vLowerLimit) Then
If CSng(zStrValue) <= CSng(vLowerLimit) Then
bVerifyTextBoxNumber = False
End If
End If
If Not IsMissing(vUpperLimit) Then
If CSng(zStrValue) >= CSng(vUpperLimit) Then
bVerifyTextBoxNumber = False
End If
End If
#If cModeDebug Then
If (Not IsMissing(vLowerLimit)) And _
(Not IsMissing(vUpperLimit)) Then
If CSng(vLowerLimit) >= CSng(vUpperLimit) Then
MsgBox zErrorData, vbOKOnly + vbCritical, _
"bVerifyTextBoxNumber()- Error: Invalid Call to Function"
End If
End If
#End If
Case vbDouble
If Not IsMissing(vLowerLimit) Then
If CDbl(zStrValue) <= CDbl(vLowerLimit) Then
bVerifyTextBoxNumber = False
End If
End If
If Not IsMissing(vUpperLimit) Then
If CDbl(zStrValue) >= CDbl(vUpperLimit) Then
bVerifyTextBoxNumber = False
End If
End If
#If cModeDebug Then
If (Not IsMissing(vLowerLimit)) And _
(Not IsMissing(vUpperLimit)) Then
If CDbl(vLowerLimit) >= CDbl(vUpperLimit) Then
MsgBox zErrorData, vbOKOnly + vbCritical, _
"bVerifyTextBoxNumber()- Error: Invalid Call to Function"
End If
End If
#End If
Case vbInteger
If Not IsMissing(vLowerLimit) Then
If CInt(zStrValue) <= CInt(vLowerLimit) Then
bVerifyTextBoxNumber = False
End If
End If
If Not IsMissing(vUpperLimit) Then
If CInt(zStrValue) >= CInt(vUpperLimit) Then
bVerifyTextBoxNumber = False
End If
End If
If bCheckforDecimal(zStrValue) Then bVerifyTextBoxNumber = False
#If cModeDebug Then
If (Not IsMissing(vLowerLimit)) And _
(Not IsMissing(vUpperLimit)) Then
If CInt(vLowerLimit) >= CInt(vUpperLimit) Then
MsgBox zErrorData, vbOKOnly + vbCritical, _
"bVerifyTextBoxNumber()- Error: Invalid Call to Function"
End If
End If
#End If
Case vbLong
If Not IsMissing(vLowerLimit) Then
If CLng(zStrValue) <= CLng(vLowerLimit) Then
bVerifyTextBoxNumber = False
End If
End If
If Not IsMissing(vUpperLimit) Then
If CLng(zStrValue) >= CLng(vUpperLimit) Then
bVerifyTextBoxNumber = False
End If
End If
If bCheckforDecimal(zStrValue) Then bVerifyTextBoxNumber = False
#If cModeDebug Then
If (Not IsMissing(vLowerLimit)) And _
(Not IsMissing(vUpperLimit)) Then
If CLng(vLowerLimit) >= CLng(vUpperLimit) Then
MsgBox zErrorData, vbOKOnly + vbCritical, _
"bVerifyTextBoxNumber()- Error: Invalid Call to Function"
End If
End If
#End If
Case Else
MsgBox "The data type { " & zDatatypes(iDataType) & _
" } is not supported by the bVerifyTextBoxNumber function." & _
vbCrLf & "Supported datatypes:" & vbCrLf & _
"vbCurrency; vbDouble; vbInteger;" & vbCrLf & _
"vbLong; and vbSingle", _
vbOKOnly + vbCritical, _
"bVerifyTextBoxNumber()- Error: Unsupported Data Type"
bVerifyTextBoxNumber = False
End Select '*** Case iDataType ***
Exit Function
ErrorTrap:
zErrorData = "Data Type Requested: " & vbTab & zDatatypes(iDataType) & vbCrLf & _
"Data Value Passed: " & vbTab & vbTab & zStrValue & vbCrLf & _
"Lower Limit Passed: " & vbTab & vbTab & _
IIf(Not IsMissing(vLowerLimit), vLowerLimit, "None") & vbCrLf & _
"Upper Limit Passed: " & vbTab & vbTab & _
IIf(Not IsMissing(vUpperLimit), vUpperLimit, "None")
Select Case Err()
Case 6: '*** OverFlow Error - Number too large for type ***
MsgBox "One of the arguments passed caused an Overflow error:" & _
vbCrLf & zErrorData, _
vbCritical + vbOKOnly, _
"bVerifyTextBoxNumber()- Error: Argument out of Range"
Exit Function
Case 13: '*** Type Mismatch Error - Can't convert to number ***
MsgBox "One of the arguments passed caused an Type Mismatch error:" & _
vbCrLf & zErrorData, _
vbCritical + vbOKOnly, _
"bVerifyTextBoxNumber()- Error: Argument out of Range"
Exit Function
Case Else
MsgBox "Error Number: " & Format(Err.Number) & vbCrLf & _
"Error Description: " & Err.Description & vbCrLf & vbCrLf & _
"Contact your system programmer immediately!" & vbCrLf & vbCrLf & _
zErrorData, vbOKOnly + vbCritical, _
"bVerifyTextBoxNumber()- Error: Unknown Error"
End Select
End Function '*** bVerifyTextBoxNumber ***
Function bCheckforDecimal(zStrValue As Variant) As Boolean
'*** Returns True if number contains decimal VALUES!
'*** Returns False even if there is a decimal but no decimal values.
Dim iDecimalLoc As Integer
'*** Check for decimal point. If decimal present and not last character ERROR ***
iDecimalLoc = InStr(zStrValue, ".")
If iDecimalLoc <> 0 And iDecimalLoc < Len(zStrValue) Then
bCheckforDecimal = True
Else
bCheckforDecimal = False
End If
End Function
' +-------------------------+ +----------+
'-------------------------| bVerifyTextBoxDate() |-------------| 08/26/10 |
' +-------------------------+ +----------+
Public Function bVerifyTextBoxDate(zDateValue As String, _
Optional vLowerLimit As Variant, _
Optional vUpperLimit As Variant)
Dim zErrorData As String
On Error GoTo DateError
bVerifyTextBoxDate = True
If Not IsDate(zDateValue) Then
bVerifyTextBoxDate = False
Exit Function
End If
If Not IsMissing(vLowerLimit) Then
If CDate(zDateValue) <= CDate(vLowerLimit) Then
bVerifyTextBoxDate = False
End If
End If
If Not IsMissing(vUpperLimit) Then
If CDate(zDateValue) >= CDate(vUpperLimit) Then
bVerifyTextBoxDate = False
End If
End If
#If cModeDebug Then
zErrorData = "Lower Limit is GREATER than or Equal to Upper Limit!" & _
vbCrLf & vbCrLf & _
"Data Value Passed: " & vbTab & vbTab & zDateValue & vbCrLf & _
"Lower Limit Passed: " & vbTab & vbTab & _
IIf(Not IsMissing(vLowerLimit), vLowerLimit, "None") & vbCrLf & _
"Upper Limit Passed: " & vbTab & vbTab & _
IIf(Not IsMissing(vUpperLimit), vUpperLimit, "None")
If (Not IsMissing(vLowerLimit)) And _
(Not IsMissing(vUpperLimit)) Then
If CDate(vLowerLimit) >= CDate(vUpperLimit) Then
MsgBox zErrorData, vbOKOnly + vbCritical, _
"bVerifyTextBoxDate()- Error: Invalid Call to Function"
End If
End If
#End If
Exit Function
DateError:
zErrorData = "One of the data values passed can not be converted " & _
"into a date!" & vbCrLf & _
"Data Value Passed: " & vbTab & vbTab & zDateValue & vbCrLf & _
"Lower Limit Passed: " & vbTab & vbTab & _
IIf(Not IsMissing(vLowerLimit), vLowerLimit, "None") & vbCrLf & _
"Upper Limit Passed: " & vbTab & vbTab & _
IIf(Not IsMissing(vUpperLimit), vUpperLimit, "None")
Select Case Err()
Case 13: '*** Type Mismatch Error - Can't convert to date ***
MsgBox zErrorData, _
vbCritical + vbOKOnly, _
"bVerifyTextBoxDate()- Error: Argument Type Mismatch"
Exit Function
Case Else
MsgBox "Error Number: " & Format(Err.Number) & vbCrLf & _
"Error Description: " & Err.Description & vbCrLf & vbCrLf & _
"Contact your system programmer immediately!" & vbCrLf & vbCrLf & _
zErrorData, vbOKOnly + vbCritical, _
"bVerifyTextBoxDate()- Error: Unknown Error"
End Select
End Function '*** bVerifyTextBoxDate() ***
一个适用于我的示例数据验证公式如下：
=H2=ROUND(H2,2)