Как округлить с 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 округлите вниз?

Ответ 1

VBA использует округление банкиров, чтобы компенсировать смещение, всегда округляя вверх или вниз на.5; вы можете вместо этого;

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

Ответ 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----------------

Ответ 3

Если вы хотите округлить, используйте половину регулировки. Добавьте 0.5 к числу, которое нужно округлить, и используйте функцию INT().

answer = INT (x + 0,5)

Ответ 4

Я представляю две пользовательские функции библиотеки, которые будут использоваться в 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

Ответ 5

Попробуйте функцию RoundUp:

Dim i As Double

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

Ответ 6

У меня была проблема, когда мне приходилось только округлять, и эти ответы не работали, поскольку я должен был запустить мой код, поэтому я использовал другой метод. Функция INT округляется до отрицательной (4.2 переходит в 4, -4.2 переходит в -5). Поэтому я изменил свою функцию на отрицательную, применил функцию INT, а затем положил ее положительно, просто умножив ее на -1 до и после

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

Ответ 7

Math.Round использует округление банкиров и округляется до ближайшего четного числа, если число, подлежащее округлению, падает ровно посередине.

Простое решение, используйте Worksheetfunction.Round(). Это будет округлено, если оно на краю.

Ответ 8

Это пример 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.

Ответ 9

Использовал функцию "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

Ответ 10

Здесь я сделал. Он не использует вторую переменную, которая мне нравится.

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

Ответ 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

Ответ 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

Ответ 13

Ответы здесь видны по всей карте и пытаются выполнить несколько разных вещей. Я просто укажу вам ответ, который я недавно дал, в котором обсуждается принудительное округление 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

Некоторые из приведенных выше ответов охватывают аналогичную территорию, но они здесь самодостаточны. Я также обсуждаю в своем другом ответе некоторые однострочные быстрые и грязные способы округления.

Ответ 14

У меня есть обходной путь:

    '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

Не стесняйтесь благодарить меня. Работает как шарм для меня, и функция автосохранения также работает!