如何用excel VBA round（）来完成？
我有以下数据：
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 ，下降？
VBA使用四舍五入来试图补偿总是四舍五入的偏差。 你可以改为;
WorksheetFunction.Round(cells(1,1).value * cells(1,2).value, 2)
如果你想整理，使用一半调整。 向数字中加0.5，并使用round（）函数。
答案=圆（x + 0.5）
尝试这个function，可以把一个double加起来
'---------------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----------------
我遇到了一个问题，我不得不四舍五入，这些答案并不适用于我必须运行代码，所以我使用了不同的方法。 INT函数向负数舍入（4.2变为4，-4.2变为-5）因此，我将函数改为负数，应用了INT函数，然后简单地通过-1乘以-1来返回正数
Count = -1 * (int(-1 * x))
尝试RoundUpfunction：
Dim i As Double i = Application.WorksheetFunction.RoundUp(Cells(1, 1).Value * Cells(1, 2).Value, 2)
我介绍了两个自定义库函数在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
Math.Round使用银行家四舍五入，如果要舍入的数字正好落在中间，则会绕到最接近的偶数。
简单的解决scheme，使用Worksheetfunction.Round（）。 如果它在边缘，那将会收尾。
在ShamBhagwat中使用了“RDown”和“RUp”函数，并创build了另一个函数返回圆形部分（不需要input“digits”），
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
这是一个例子，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。
我自己有一个解决方法：
'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
随时感谢我。 像我的魅力和autosizefunction也起作用！