如何使用 Excel VBA 四舍五入到一定数量的有效数字？

Question

编辑：这部分解决了！

所以我在一个我正在做的程序中有一堆计算，而且数字变得太长了，以至于我得到了溢出错误。 它是由一个 50 位数字除以另一个 50 位数字之类的结果产生的。 我需要一种将特定数字四舍五入到一定数量的有效数字的方法。

这里有更多信息。 首先，我将四舍五入的所有数字都将始终小于 1。数字可以小到 1E-50。 我只关心前 10 位左右的有效数字。 在继续下一个计算之前，我只需要一种方法将其四舍五入到大约 10 sig figs，以防止溢出错误。 那，并且有一个数字达到 50 个数字是非常没用的。

我在想也许可以逐个数字地循环遍历数字？ 当数字等于 0 时，该程序可以将 1 加到计数器上，然后在遇到除零以外的任何值时跳出循环。 然后下一步可以将数字截断到该计数器加上我想要的许多有效数字。

例如，对于 .000001234567812345678。 它将返回 5 个零。 如果我想要十个有效数字，我会做五 + 十 = 15。然后程序将只保留小数点后的前 15 位数字，因此该数字将被截断为 0.000001234567812。

另一个想法可能是使用日志。 那么新数字的幂将是有效数字前面的零的数量。

我不知道的是，首先，如何逐位遍历一个数字，并检查每个数字是否为零。 我也不知道如何将数字截断为一定数量的数字。

任何帮助将不胜感激！

编辑：这部分没有解决。

这么快再发一个帖子我会感觉很糟糕，所以我要在这里问这个问题。 如果20分钟左右没有回复，也许我会再发一个帖子。 为什么这不起作用？

Sub Rounding()
    Tracker = 0
    For i = 1 To 10
        Tracker = Tracker + 1
        Cells(1, Tracker) = Rnd
        Cells(1, Tracker) = Application.Evaluate("=Round(Cells(1, Tracker), 4 - (Int(Log(Cells(1,Tracker))) + 1))")
    Next
    Columns("A:J").EntireColumn.AutoFit
End Sub

我在每个单元格中不断收到错误 #NAME?。 这应该将每个数字四舍五入到四位有效数字。

Answer 1

假设您的值在 A2 中，请尝试以下任一方法：

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

或者

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

取自这里。

Answer 2

当已经有一个功能可以满足您的需求时，为什么还要循环呢？

Sub Sample()
    Dim someNumber As Double

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

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

Answer 3

我发现在 excel 工作表中，可以使用： =ROUND(A2, 3-(INT(LOG(A2))+1))

但在 VBA 中，代码变为： =Round(Range("A2"), 3-(Int(Log(Range("A2"))/log(10#))+1))

Answer 4

如果 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

Answer 5

函数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