我有以下数据：
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，向下舍入？
答案 0 :(得分：15)
VBA使用bankers rounding试图补偿总是向上或向下四舍五入的偏差。你可以改为;
WorksheetFunction.Round(cells(1,1).value * cells(1,2).value, 2)
答案 1 :(得分：8)
试试这个功能，可以整理一个双
'---------------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----------------
答案 2 :(得分：8)
如果要围绕，请使用半调整。将0.5添加到要舍入的数字并使用INT（）函数。
回答= INT（x + 0.5）
答案 3 :(得分：3)
我介绍了两个用于vba的自定义库函数，它将用于舍入double值而不是使用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
答案 4 :(得分：1)
尝试RoundUp功能：
Dim i As Double
i = Application.WorksheetFunction.RoundUp(Cells(1, 1).Value * Cells(1, 2).Value, 2)
答案 5 :(得分：1)
我遇到了一个问题，我只需要整理，这些答案对我如何运行代码无效，所以我使用了不同的方法。 INT函数向负方向舍入（4.2变为4，-4.2变为-5） 因此，我将我的函数更改为负数，应用INT函数，然后将其返回到正数，只需将其乘以-1前后
Count = -1 * (int(-1 * x))
答案 6 :(得分：0)
Math.Round使用Bankers四舍五入，如果要舍入的数字恰好位于中间，则将舍入到最接近的偶数。
简单的解决方案，使用Worksheetfunction.Round（）。如果它处于边缘，这将会四舍五入。
答案 7 :(得分：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.
答案 8 :(得分：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
答案 9 :(得分：0)
这是我制作的。它没有使用我喜欢的第二个变量。
Points = Len(Cells(1, i)) * 1.2
If Round(Points) >= Points Then
Points = Round(Points)
Else: Points = Round(Points) + 1
End If
答案 10 :(得分：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
答案 11 :(得分：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
答案 12 :(得分：0)
这里的答案遍及整个地图，并尝试完成一些不同的事情。我只是将您指向the answer，我最近在此讨论了强制向上舍入的问题-即，根本不舍入为零。这里的答案涵盖了不同的舍入类型，而ana的答案例如是用于强制舍入的。
要清楚，最初的问题是如何“正常舍入”-因此，“对于值> 0.5，向上舍入。对于值<0.5，则向下舍入”。
我链接到那里的答案讨论了强制取整，有时您也想这样做。 Excel的常规ROUND使用round-half-up，而其ROUNDUP使用从零开始舍入。因此，这里有两个在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
上面的一些答案涵盖了相似的领域，但是这里的答案是独立的。我还将在其他答案中讨论一些单线快速和肮脏的方法进行汇总。
答案 13 :(得分：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
答案 14 :(得分：-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
随意感谢我。对我来说就像魅力一样，自动调整功能也有效！