使用WorksheetFunction.FLOOR（1.11116，0.0001）--> 1.1111

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  Const TARGET_RANGE As String = "A1:A10"
  Const DECIMAL_PLACES As Double = 0.00001
  On Error GoTo ClearError
  Dim irg As Range
  Set irg = Interesect(Me.Range(TARGET_RANGE), Target)
  If irg Is Nothing Then Exit Sub
  Application.EnableEvents = False
  Dim iCell As Range, iValue as Variant
  For Each iCell In irg.Cells
    iValue = iCell.Value
    If VarType(iValue) = vbDouble Then
      iCell.Value = WorksheetFunction.FLOOR(iValue, DECIMAL_PLACES)
    End If
  Next iCell
ProcExit:
  On Error Resume Next
  If Not Application.EnbaleEvents Then Application.EnableEvents = True
  Exit Sub
ClearError:
  Resume ProcExit
End Sub

字符串

工作表变更：自动截断小数2

改善

• 在我的previous answer中，我没有意识到浮点数在小数位数较多时会有问题。各种数学函数可以涵盖这一点。我选择了RoundUp，它似乎是轻松处理需求的完美候选。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Const TARGET_RANGE As String = "A1:A10"
    Const DECIMAL_PLACES As Long = 5
    Const DEBUG_PRINT_CHANGES As Boolean = True ' set to False when done testing

    On Error GoTo ClearError
    
    ' Attempt to reference (manually) changed cells of target range.
    Dim irg As Range: Set irg = Intersect(Me.Range(TARGET_RANGE), Target)
    If irg Is Nothing Then Exit Sub

    Application.EnableEvents = False

    Dim iCell As Range, Current, RoundedDown As Double, IsToBeChanged As Boolean

    For Each iCell In irg.Cells
        Current = iCell.Value
        ' Set flag if current value is DIFFERENT than rounded down value.
        ' NOT greater than because after rounding down,
        ' negative numbers may only become GREATER i.e. '-2.2 > -2.21'.
        If VarType(Current) = vbDouble Then ' is a number
            RoundedDown = Application.RoundDown(Current, DECIMAL_PLACES)
            If RoundedDown <> Current Then
                IsToBeChanged = True
            End If
        End If
        ' Print information to Immediate window (Ctrl+G).
        If DEBUG_PRINT_CHANGES Then
            Debug.Print IIf(IsToBeChanged, "Changed:     ", "Not changed: ") _
                & IIf(IsError(Current), iCell.Text, Current) _
                & IIf(IsToBeChanged, " to " & RoundedDown, "")
        End If
        ' If flag was set, write rounded down value to cell and reset flag.
        If IsToBeChanged Then
            iCell.Value = RoundedDown
            IsToBeChanged = False
        End If
    Next iCell

ProcExit:
    On Error Resume Next
        If Not Application.EnableEvents Then Application.EnableEvents = True
    On Error GoTo 0
    Exit Sub
ClearError:
    Resume ProcExit
End Sub

字符串

的数据

即时窗口中的结果

Changed:     123.123455667 to 123.12345
Changed:     21.12312345 to 21.12312
Not changed: 1.11116
Changed:     -200.23423423 to -200.23423
Not changed: 100.36
Changed:     0.833599537037037 to 0.83359
Not changed: #DIV/0!
Not changed: #NAME?
Not changed: 45132
Not changed: Text

型

发生了什么事？

Sub Float()
    Debug.Print 100000 * 1.11116               ' Result: 111116
    Debug.Print Int(100000 * 1.11116)          ' Result: 111115 ' here!!!
    Debug.Print Int(100000 * 1.11116) / 100000 ' Result: 1.11115
End Sub

型

• 请注意，这不是一个bug。这是正常的行为。
  您的文章中的错别字

Interesect --> Intersect
Application.EnbaleEvents --> Application.EnableEvents
On Error GoTo O --> On Error GoTo 0
10^DECIMAL_PLACES --> 10 ^ DECIMAL_PLACES

型