假设你的值在A2中，尝试以下任一项：

=ROUND(A2, 3-(INT(LOG(A2))+1))

或

=ROUND(A2,3-LEN(INT(A2)))

来自here

当已经有一个函数给你想要的东西时，你为什么要循环？

Sub Sample()
    Dim someNumber As Double

    '~~> .000001234567812345678
    someNumber = 1.23456781234568E-06

    '~~> This will give you .000001234567812
    Debug.Print Round(someNumber, 15)
End Sub

我发现在Excel工作表中，可以用途：=ROUND（A2，3-（INT（LOG（A2））+1））
但在VBA中，代码变为：=Round（Range（“A2”），3-（Int（Log（Range（“A2”））/log（10#））+1））

如果3-（Int（Log（Range（“A2”））/log（10#））+1））为负（即，如果小数点前的有效数字多于您希望舍入的数字）。另一种选择是

Public Function round_sigfig(ByVal myval As Double, ByVal fignum As Integer) As Double
factor = 10 ^ (fignum - (Int(Log(myval) / Log(10#))) - 1)
round_sigfig = Round(myval * factor, 0) / factor
End Function

函数roundSignif将x舍入为sd有效位。适用于所有数字（x < 1以及x >= 1，也适用于所有负数和0）

' Round `x` to `sd` significant digits
Function roundSignif(x As Double, sd As Integer) As Double
    Dim oom As Integer
    Dim d As Integer
    
    oom = orderOfMag(x)
    d = -oom + sd - 1
    
    If d >= 0 Then
        roundSignif = Round(x, d)
    Else
        ' rounding to a negative number of digits is not possible
        roundSignif = Round(x * 10 ^ d, 0) / 10 ^ d
    End If
End Function

' Return order of magnitude of `x`
Function orderOfMag(x As Double) As Integer
    If x = 0 Then
        orderOfMag = 0
    ElseIf Abs(x) < 1 Then
        orderOfMag = WorksheetFunction.RoundUp(WorksheetFunction.Log10(Abs(x)), 0)
    Else
        orderOfMag = WorksheetFunction.RoundDown(WorksheetFunction.Log10(Abs(x)), 0)
    End If
End Function

测试...

Sub testRoundSignif()
    Dim x As Variant
    For Each x In Array(0, 1, 11, 111, -111, 0.0987, -0.123)
        Debug.Print (x & " -> " & roundSignif(CDbl(x), 2))
    Next x
End Sub

0 -> 0
1 -> 1
11 -> 11
111 -> 110
-111 -> -110
0.0987 -> 0.099
-0.123 -> -0.12

未使用WorksheetFunction的版本用于与其他vba平台的可移植性测试：101.538=1016，10.1254=10。13，3.64589=3。646，2.1=2.1，35845。65=35850，-25。438 = -25.44，-15687。354 = -1569，-100= -100，84354。34=84360

Sub test()
    Dim testStr As String
    Dim num, testNum As Variant
    
    testStr = "101.538, 10.1254, 3.64589, 2.1, 35845.65, -25.438, -15687.354, -100, 84354.34"
    testNum = Split(testStr, ",")
    
    For Each num In testNum
        Debug.Print roundupSignifDigits(num, 4)
    Next num
End Sub

Function roundupSignifDigits(inputNum, signifDigits As Integer)

    'rounds up the inputNum to number of significant Digits
    'Example Usage -> Debug.Print roundupSignifDigits(num, 4)
    
    Dim flag, i, NegFact As Integer
    Dim mult  As Double
    
    'If inputNum is negative then take absolute value and then multiply answer at end by NegFact to make it negative again
    If inputNum < 0 Then
        NegFact = -1
        inputNum = Abs(inputNum)
        Else: NegFact = 1
    End If
    
    mult = 10 ^ (signifDigits - 1)
    
    'first check if number is greater than 1 or less than 1
    If inputNum > 1 Then flag = 1 Else flag = 0
    
    Select Case flag
        Case 1
            Do
                i = i + 1
            Loop Until inputNum / 10 ^ i < 1
            inputNum = inputNum / 10 ^ (i - 1)
            roundupSignifDigits = NegFact * Int(inputNum * -mult) / -mult * 10 ^ (i - 1)
    
        Case 0
            Do
                i = i - 1
            Loop Until inputNum / 10 ^ i > 1
            inputNum = inputNum / 10 ^ i
            roundupSignifDigits = NegFact * Int(inputNum * -mult) / -mult * 10 ^ i
    End Select

End Function