如何用Excel VBA round()进行四舍五入？

Question

我有以下数据：

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

，向下舍入？

Answer 1

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

WorksheetFunction.Round(cells(1,1).value * cells(1,2).value, 2)

Answer 2

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

答案 = INT(x + 0.5)

Answer 3

试试这个函数，四舍五入就可以了

'---------------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----------------

Answer 4

尝试 RoundUp 功能：

Dim i As Double

i = Application.WorksheetFunction.RoundUp(Cells(1, 1).Value * Cells(1, 2).Value, 2)

Answer 5

我介绍了在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

Answer 6

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

Count = -1 * (int(-1 * x))

Answer 7

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

简单的解决方案，使用 Worksheetfunction.Round()。如果它位于边缘，则会四舍五入。

Answer 8

使用 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

Answer 9

这是一个示例 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。

Answer 10

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

        Points = Len(Cells(1, i)) * 1.2
        If Round(Points) >= Points Then
            Points = Round(Points)
        Else: Points = Round(Points) + 1
        End If

Answer 11

这对我有用

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

Answer 12

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

'
' 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

Answer 13

这里的答案有点五花八门，并尝试完成几件不同的事情。我只想向您指出我最近给出的讨论强制向上舍入的答案，即根本不向零舍入。这里的答案涵盖了不同类型的舍入，例如 ana 的答案是强制舍入。需要明确的是，最初的问题是如何“正常舍入”——因此，“对于值 > 0.5，向上舍入。对于值

我链接到的答案讨论了强制舍入，有时您也想这样做。 Excel 的普通 ROUND 使用 < 0.5, round down".

round-half-up，而其 ROUNDUP 使用 round-away-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

上面的一些答案涵盖了类似的领域，但这里的这些答案是独立的。  我还在我的另一个答案中讨论了一些简单快捷的四舍五入方法。

Answer 14

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

Answer 15

函数 RoundUp(ByVal d As Double,digits As Integer) As Single 暗淡结果为单身

result = Math.Round(d, digits) If result >= d Then RoundUp = result Else RoundUp = result + (1 / (10 ^ digits)) End If

结束功能

Answer 16

'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

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

如何用Excel VBA round()进行四舍五入？

问题描述投票：0回答：16

16个回答

最新问题

如何用Excel VBA round()进行四舍五入？

问题描述 投票：0回答：16

16个回答

最新问题

问题描述投票：0回答：16