11

我有以下数据：

cell(1,1) = 2878.75
cell(1,2) = $31.10
cell(2,1) = $89,529.13

但是，当我尝试使用round(cells(1,1).value*cells(1,2).value),2)时，结果不匹配cell(2,1)。我认为这与舍入问题有关，但我只是想知道是否有可能round()正常行事。也就是说，对于value > 0.5，四舍五入。而对于value < 0.5，向下取整？

4

15 回答 15

17

VBA 使用银行家四舍五入来补偿总是向上或向下舍入 0.5 的偏差；你可以改为；

WorksheetFunction.Round(cells(1,1).value * cells(1,2).value, 2)
于 2013-04-15T14:24:18.477 回答
11



试试这个功能，双舍入就OK了

'---------------Start -------------
Function Round_Up(ByVal d As Double) As Integer
    Dim result As Integer
    result = Math.Round(d)
    If result >= d Then
        Round_Up = result
    Else
        Round_Up = result + 1
    End If
End Function
'-----------------End----------------
于 2013-11-14T04:41:05.820 回答
11

如果要四舍五入，请使用半调整。将 0.5 添加到要四舍五入的数字并使用 INT() 函数。

答案 = INT(x + 0.5)

于 2015-05-14T14:28:52.377 回答
3

试试 RoundUp 函数：

Dim i As Double

i = Application.WorksheetFunction.RoundUp(Cells(1, 1).Value * Cells(1, 2).Value, 2)
于 2013-04-15T14:23:21.043 回答
3

我正在介绍两个要在 vba 中使用的自定义库函数，它们将用于舍入双精度值而不是使用 WorkSheetFunction.RoundDown 和 WorkSheetFunction.RoundUp

Function RDown(Amount As Double, digits As Integer) As Double
    RDown = Int((Amount + (1 / (10 ^ (digits + 1)))) * (10 ^ digits)) / (10 ^ digits)
End Function

Function RUp(Amount As Double, digits As Integer) As Double
    RUp = RDown(Amount + (5 / (10 ^ (digits + 1))), digits)
End Function

因此函数 Rdown(2878.75 * 31.1,2) 将返回 899529.12 并且函数 RUp(2878.75 * 31.1,2) 将返回 899529.13 而函数 Rdown(2878.75 * 31.1,-3) 将返回 89000 并且函数 RUp(2878.75 * 31.1,- 3) 将返回 90000

于 2016-06-20T09:47:20.077 回答
2

我有一个问题，我只需要四舍五入，而这些答案对于我必须如何运行我的代码不起作用，所以我使用了不同的方法。INT 函数向负数舍入（4.2 变为 4，-4.2 变为 -5）因此，我将函数更改为负数，应用 INT 函数，然后通过在前后乘以 -1 将其返回为正数

Count = -1 * (int(-1 * x))
于 2016-10-26T14:01:09.673 回答
0

我的建议等于 Worksheetfunction.RoundUp

Function RoundUp(ByVal Number As Double, Optional ByVal Digits As Integer = 0) As Double
    Dim TempNumber As Double, Mantissa As Double
    
    'If Digits is minor than zero assign to zero.
    If Digits < 0 Then Digits = 0
    
    'Get number for x digits
    TempNumber = Number * (10 ^ Digits)
    
    'Get Mantisa for x digits
    Mantissa = TempNumber - Int(TempNumber)
    
    'If mantisa is not zero, get integer part of TempNumber and increment for 1.
    'If mantisa is zero then we reach the total number of digits of the mantissa of the original number
    If Mantissa <> 0 Then
        RoundUp = (Int(TempNumber) + 1) / (10 ^ Digits)
    Else
        RoundUp = Number
    End If
End Function
于 2021-04-18T16:10:48.370 回答
0

这对我有用 

Function round_Up_To_Int(n As Double)
    If Math.Round(n) = n Or Math.Round(n) = 0 Then
        round_Up_To_Int = Math.Round(n)
    Else: round_Up_To_Int = Math.Round(n + 0.5)
    End If
End Function
于 2018-11-01T15:10:27.297 回答
0

使用来自 ShamBhagwat 的函数“RDown”和“RUp”，并创建了另一个返回圆形部分的函数（无需输入“数字”）

Function RoundDown(a As Double, digits As Integer) As Double
    RoundDown = Int((a + (1 / (10 ^ (digits + 1)))) * (10 ^ digits)) / (10 ^ digits)
End Function

Function RoundUp(a As Double, digits As Integer) As Double
    RoundUp = RoundDown(a + (5 / (10 ^ (digits + 1))), digits)
End Function

Function RDownAuto(a As Double) As Double
    Dim i As Integer
    For i = 0 To 17
        If Abs(a * 10) > WorksheetFunction.Power(10, -(i - 1)) Then
            If a > 0 Then
                RDownAuto = RoundDown(a, i)
            Else
                RDownAuto = RoundUp(a, i)
            End If
        Exit Function
        End If
    Next
End Function

输出将是：

RDownAuto(458.067)=458
RDownAuto(10.11)=10
RDownAuto(0.85)=0.8
RDownAuto(0.0052)=0.005
RDownAuto(-458.067)=-458
RDownAuto(-10.11)=-10
RDownAuto(-0.85)=-0.8
RDownAuto(-0.0052)=-0.005
于 2016-12-14T10:00:17.553 回答
0

Math.Round 使用银行家四舍五入，如果要四舍五入的数字正好在中间，则将四舍五入到最接近的偶数。

简单的解决方案，使用 Worksheetfunction.Round()。如果它在边缘，那将四舍五入。

于 2016-07-22T05:16:31.783 回答
0

这是一个示例 j 是您要四舍五入的值。

Dim i As Integer
Dim ii, j As Double

j = 27.11
i = (j) ' i is an integer and truncates the decimal

ii = (j) ' ii retains the decimal

If ii - i > 0 Then i = i + 1

如果余数大于 0，则将其四舍五入，很简单。在 1.5 时，它会自动舍入为 2，因此它会小于 0。

于 2016-09-23T00:01:02.877 回答
0

这里的答案有点遍及整个地图，并尝试完成几件不同的事情。我将向您指出我最近给出的讨论强制向上舍入的答案- 即根本不向零舍入。这里的答案涵盖了不同类型的四舍五入，例如，ana 的答案是强制四舍五入。

需要明确的是，最初的问题是如何“正常四舍五入”——所以，“对于值 > 0.5，向上舍入。对于值 < 0.5，向下舍入”。

我链接到那里的答案讨论了强制四舍五入，您有时也想这样做。Excel 的普通 ROUND 使用round-half-up，它的 ROUNDUP 使用round-off-from-zero。所以这里有两个模仿VBA中ROUNDUP的函数，第二个只取整为整数。

Function RoundUpVBA(InputDbl As Double, Digits As Integer) As Double

    If InputDbl >= O Then
        If InputDbl = Round(InputDbl, Digits) Then RoundUpVBA = InputDbl Else RoundUpVBA = Round(InputDbl + 0.5 / (10 ^ Digits), Digits)
    Else
        If InputDbl = Round(InputDbl, Digits) Then RoundUpVBA = InputDbl Else RoundUpVBA = Round(InputDbl - 0.5 / (10 ^ Digits), Digits)
    End If

End Function

或者：

Function RoundUpToWhole(InputDbl As Double) As Integer

    Dim TruncatedDbl As Double

    TruncatedDbl = Fix(InputDbl)

    If TruncatedDbl <> InputDbl Then
        If TruncatedDbl >= 0 Then RoundUpToWhole = TruncatedDbl + 1 Else RoundUpToWhole = TruncatedDbl - 1
    Else
        RoundUpToWhole = TruncatedDbl
    End If

End Function

上面的一些答案涵盖了类似的领域，但这里的答案是独立的。我还在我的另一个答案中讨论了一些单行快速而肮脏的方法来总结。

于 2019-10-13T16:11:23.293 回答
0

我发现以下功能就足够了：

'
' Round Up to the given number of digits
'
Function RoundUp(x As Double, digits As Integer) As Double

    If x = Round(x, digits) Then
        RoundUp = x
    Else
        RoundUp = Round(x + 0.5 / (10 ^ digits), digits)
    End If

End Function
于 2019-06-06T05:15:01.583 回答
0

这是我做的一个。它不使用我喜欢的第二个变量。

        Points = Len(Cells(1, i)) * 1.2
        If Round(Points) >= Points Then
            Points = Round(Points)
        Else: Points = Round(Points) + 1
        End If
于 2018-05-18T14:02:02.957 回答
-3

我自己有一个解决方法：

    'G = Maximum amount of characters for width of comment cell
    G = 100
    'CommentX
    If THISWB.Sheets("Source").Cells(i, CommentColumn).Value = "" Then
        CommentX = ""
     Else
        CommentArray = Split(THISWB.Sheets("Source").Cells(i, CommentColumn).Value, Chr(10)) 'splits on alt + enter
        DeliverableComment = "Available"
    End If
                        If CommentX <> "" Then

                            'this loops for each newline in a cell (alt+enter in cell)
                            For CommentPart = 0 To UBound(CommentArray)
                            'format comment to max G characters long
                                LASTSPACE = 0
                                LASTSPACE2 = 0
                                    If Len(CommentArray(CommentPart)) > G Then

                                        'find last space in G length character string to make sure the line ends with a whole word and the new line starts with a whole word
                                        Do Until LASTSPACE2 >= Len(CommentArray(CommentPart))
                                            If CommentPart = 0 And LASTSPACE2 = 0 And LASTSPACE = 0 Then
                                                LASTSPACE = WorksheetFunction.Find("þ", WorksheetFunction.Substitute(Left(CommentArray(CommentPart), G), " ", "þ", (Len(Left(CommentArray(CommentPart), G)) - Len(WorksheetFunction.Substitute(Left(CommentArray(CommentPart), G), " ", "")))))
                                                ActiveCell.AddComment Left(CommentArray(CommentPart), LASTSPACE)
                                            Else
                                                If LASTSPACE2 = 0 Then
                                                   LASTSPACE = WorksheetFunction.Find("þ", WorksheetFunction.Substitute(Left(CommentArray(CommentPart), G), " ", "þ", (Len(Left(CommentArray(CommentPart), G)) - Len(WorksheetFunction.Substitute(Left(CommentArray(CommentPart), G), " ", "")))))
                                                   ActiveCell.Comment.Text Text:=ActiveCell.Comment.Text & vbNewLine & Left(CommentArray(CommentPart), LASTSPACE)
                                                Else
                                                   If Len(Mid(CommentArray(CommentPart), LASTSPACE2)) < G Then
                                                       LASTSPACE = Len(Mid(CommentArray(CommentPart), LASTSPACE2))
                                                       ActiveCell.Comment.Text Text:=ActiveCell.Comment.Text & vbNewLine & Mid(CommentArray(CommentPart), LASTSPACE2 - 1, LASTSPACE)
                                                   Else
                                                       LASTSPACE = WorksheetFunction.Find("þ", WorksheetFunction.Substitute(Mid(CommentArray(CommentPart), LASTSPACE2, G), " ", "þ", (Len(Mid(CommentArray(CommentPart), LASTSPACE2, G)) - Len(WorksheetFunction.Substitute(Mid(CommentArray(CommentPart), LASTSPACE2, G), " ", "")))))
                                                       ActiveCell.Comment.Text Text:=ActiveCell.Comment.Text & vbNewLine & Mid(CommentArray(CommentPart), LASTSPACE2 - 1, LASTSPACE)
                                                   End If
                                                End If
                                            End If
                                            LASTSPACE2 = LASTSPACE + LASTSPACE2 + 1
                                        Loop
                                    Else
                                        If CommentPart = 0 And LASTSPACE2 = 0 And LASTSPACE = 0 Then
                                          ActiveCell.AddComment CommentArray(CommentPart)
                                        Else
                                          ActiveCell.Comment.Text Text:=ActiveCell.Comment.Text & vbNewLine & CommentArray(CommentPart)
                                        End If
                                    End If

                            Next CommentPart
                            ActiveCell.Comment.Shape.TextFrame.AutoSize = True

                        End If

随时感谢我。对我来说就像一个魅力，自动调整大小功能也有效！

于 2016-01-05T06:45:05.900 回答