如何使用Excel数据验证,以便可以输入精确的两位小数?

nsc4cvqm  于 2023-06-25  发布在  其他
关注(0)|答案(2)|浏览(186)

问题陈述:

  1. Excel单元格中的数据验证。
    1.用户只能输入2位小数。所以,11点,但不是11点或11点。
    我尝试过的:
INT(A1*100) = A1*100

作为数据验证公式。可悲的是,它也不允许小数或小数。

1tuwyuhd

1tuwyuhd1#

这是我在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() ***
bhmjp9jg

bhmjp9jg2#

下面是一个对我很有效的数据验证公式示例:

=H2=ROUND(H2,2)

相关问题