У меня есть следующие данные:
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 использует округление банкиров, чтобы компенсировать смещение, всегда округляя вверх или вниз на.5; вы можете вместо этого;
WorksheetFunction.Round(cells(1,1).value * cells(1,2).value, 2)
Попробуйте эту функцию, это нормально округлить двойной
'---------------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----------------
Если вы хотите округлить, используйте половину регулировки. Добавьте 0.5 к числу, которое нужно округлить, и используйте функцию INT().
answer = INT (x + 0,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
Попробуйте функцию RoundUp:
Dim i As Double
i = Application.WorksheetFunction.RoundUp(Cells(1, 1).Value * Cells(1, 2).Value, 2)
У меня была проблема, когда мне приходилось только округлять, и эти ответы не работали, поскольку я должен был запустить мой код, поэтому я использовал другой метод. Функция INT округляется до отрицательной (4.2 переходит в 4, -4.2 переходит в -5). Поэтому я изменил свою функцию на отрицательную, применил функцию INT, а затем положил ее положительно, просто умножив ее на -1 до и после
Count = -1 * (int(-1 * x))
Math.Round использует округление банкиров и округляется до ближайшего четного числа, если число, подлежащее округлению, падает ровно посередине.
Простое решение, используйте Worksheetfunction.Round(). Это будет округлено, если оно на краю.
Это пример 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.
Использовал функцию "RDown" и "RUp" из ShamBhagwat и создал еще одну функцию, которая вернет круглую часть (без необходимости указывать "цифры" для ввода)
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
Здесь я сделал. Он не использует вторую переменную, которая мне нравится.
Points = Len(Cells(1, i)) * 1.2
If Round(Points) >= Points Then
Points = Round(Points)
Else: Points = Round(Points) + 1
End If
Это сработало для меня
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
Я нахожу следующую функцию достаточной:
'
' 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
Ответы здесь видны по всей карте и пытаются выполнить несколько разных вещей. Я просто укажу вам ответ, который я недавно дал, в котором обсуждается принудительное округление UP - то есть, никакого округления до нуля вообще нет. Ответы здесь охватывают различные типы округления, и, например, ответ предназначен для принудительного округления.
Чтобы было ясно, исходный вопрос заключался в том, как "округлить в обычном режиме", то есть "для значения> 0,5, округлить вверх. И для значения & lt; 0,5, округлить вниз".
В ответе, на который я ссылаюсь, обсуждается принудительное округление, которое вы иногда тоже хотите сделать. В то время как в Excel в обычном ROUND используется округление до половины, в ROUNDUP используется округление от нуля. Итак, вот две функции, которые имитируют ROUNDUP в VBA, вторая из которых округляет только до целого числа.
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
Некоторые из приведенных выше ответов охватывают аналогичную территорию, но они здесь самодостаточны. Я также обсуждаю в своем другом ответе некоторые однострочные быстрые и грязные способы округления.
У меня есть обходной путь:
'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
Не стесняйтесь благодарить меня. Работает как шарм для меня, и функция автосохранения также работает!