MS Access、VBAで丸める方法

StackOverflow https://stackoverflow.com/questions/137114

質問

VBA Accessで丸める最良の方法は何ですか？

現在のメソッドはExcelメソッドを使用しています

Excel.WorksheetFunction.Round(...

しかし、Excelに依存しない手段を探しています。

役に立ちましたか？

解決

VBA Round関数は、Bankerの丸めを使用し、0.5を偶数に丸めます。次のように注意してください：

Round (12.55, 1) would return 12.6 (rounds up) 
Round (12.65, 1) would return 12.6 (rounds down) 
Round (12.75, 1) would return 12.8 (rounds up)

Excel Worksheet Function Roundは、常に0.5を切り上げます。

いくつかのテストを行ったところ、0.55の切り上げ（対称の丸め）がセルの書式設定にも使用され、列幅の丸めにも使用されるようです（一般的な数値形式を使用する場合）。 「表示されたままの精度」フラグは、それ自体で丸めを行うようには見えません。セル形式の丸められた結果を使用するだけです。

丸めのためにMicrosoftのSymArith関数をVBAに実装しようとしましたが、Fixに58.55などの数値を指定しようとするとエラーが発生することがわかりました。 58.6ではなく58.5の結果を与える関数。そして、ようやくExcel Worksheet Round関数を使用できることを発見しました。

  

Application.Round（58.55、1）

これにより、VBAで通常の丸めを行うことができますが、カスタム関数ほど高速ではない場合があります。これは質問から完全に一巡したことを理解していますが、完全を期すためにそれを含めたかったのです。

他のヒント

受け入れられた答えを少し拡大するには：

<！> quot; Round関数は偶数への丸めを実行しますが、これは丸めと大きく異なります。<！> quot;
--Microsoft

フォーマットは常に切り上げられます。

  Debug.Print Round(19.955, 2)
  'Answer: 19.95

  Debug.Print Format(19.955, "#.00")
  'Answer: 19.96

ACC2000：浮動小数点数を使用する場合の丸めエラー： http://support.microsoft.com/ kb / 210423

ACC2000：必要な増分で数値を切り上げるまたは切り下げる方法： http://support.microsoft .com / kb / 209996

ラウンド関数： http://msdn2.microsoft.com/en-us /library/se6f2zfx.aspx

カスタム丸め手順の実装方法： http://support.microsoft.com/kb/196652

スイスおよび保険業界の一部では、追い払われるかどうか、利益などに応じて、いくつかの丸め規則を使用する必要があります。

現在この関数を使用しています

Function roundit(value As Double, precision As Double) As Double
    roundit = Int(value / precision + 0.5) * precision
End Function

これは正常に動作するようです

IntとFixはどちらも便利な丸め関数であり、数値の整数部分を提供します。

Intは常に切り捨てられます-Int（3.5）= 3、Int（-3.5）= -4

常にゼロに向かって丸めます-Fix（3.5）= 3、Fix（-3.5）= -3

また、数値を整数型またはlong型に変換しようとする強制機能、特にCIntおよびCLngがあります（整数は-32,768〜32,767、長さは-2,147,483,648〜2,147,483,647）。これらは両方とも、最も近い整数に向かって丸められ、0.5からゼロから離れて丸められます-CInt（3.5）= 4、Cint（3.49）= 3、CInt（-3.5）= -4など。

1 place = INT(number x 10 + .5)/10
3 places = INT(number x 1000 + .5)/1000

など。多くの場合、VBAは異なるメモリ空間で動作するように見えるため、このような見苦しいソリューションはExcel関数を使用するよりもはるかに高速であることがわかります。

eg If A > B Then MaxAB = A Else MaxAB = Bは、ExcelWorksheetFunction.Maxを使用するよりも約40倍高速です

残念なことに、丸めを実行できるVBAのネイティブ機能は、欠落、制限、不正確、またはバグがあり、それぞれが単一の丸め方法のみに対応しています。利点は、それらが高速であり、状況によっては重要になる可能性があることです。

ただし、多くの場合、精度は必須であり、今日のコンピューターの速度では、単一の値の処理ではなく、少し遅い処理がほとんど気づかれません。以下のリンクのすべての関数は、約1 <！>＃181; sで実行されます。

すべての一般的な丸め方法、VBAのすべてのデータ型、任意の値、予期しない値を返さない関数の完全なセットは、次の場所にあります。

四捨五入した値、4/5、または有効数字（EE）

またはここ：

値を丸め、ダウン、4/5、または有効数字（CodePlex）

GitHubでのコードのみ：

VBA.Round

通常の丸め方法をカバーしています：

  • 切り捨て、負の値をゼロに丸めるオプション

  • 切り上げ、負の値をゼロから切り捨てるオプションを使用

  • 4 / 5、0から偶数または偶数（Banker's Rounding）でのラウンド

  • 有効数字の数に四捨五入

最初の3つの関数はすべての数値データ型を受け入れますが、最後の関数は、それぞれ通貨、小数、倍精度の3種類あります。

これらはすべて、指定された小数カウントを受け入れます-十、百などに丸める負のカウントを含みます。戻り型としてVariantを持つものは、不可解な入力に対してNullを返します

テストおよび検証用のテストモジュールも含まれています。

例はこちらです-一般的な4/5丸めの場合。微妙な詳細と、ビットエラーを回避するための CDec の使用方法については、インラインコメントをご覧ください。

' Common constants.
'
Public Const Base10     As Double = 10

' Rounds Value by 4/5 with count of decimals as specified with parameter NumDigitsAfterDecimals.
'
' Rounds to integer if NumDigitsAfterDecimals is zero.
'
' Rounds correctly Value until max/min value limited by a Scaling of 10
' raised to the power of (the number of decimals).
'
' Uses CDec() for correcting bit errors of reals.
'
' Execution time is about 1µs.
'
Public Function RoundMid( _
    ByVal Value As Variant, _
    Optional ByVal NumDigitsAfterDecimals As Long, _
    Optional ByVal MidwayRoundingToEven As Boolean) _
    As Variant

    Dim Scaling     As Variant
    Dim Half        As Variant
    Dim ScaledValue As Variant
    Dim ReturnValue As Variant

    ' Only round if Value is numeric and ReturnValue can be different from zero.
    If Not IsNumeric(Value) Then
        ' Nothing to do.
        ReturnValue = Null
    ElseIf Value = 0 Then
        ' Nothing to round.
        ' Return Value as is.
        ReturnValue = Value
    Else
        Scaling = CDec(Base10 ^ NumDigitsAfterDecimals)

        If Scaling = 0 Then
            ' A very large value for Digits has minimized scaling.
            ' Return Value as is.
            ReturnValue = Value
        ElseIf MidwayRoundingToEven Then
            ' Banker's rounding.
            If Scaling = 1 Then
                ReturnValue = Round(Value)
            Else
                ' First try with conversion to Decimal to avoid bit errors for some reals like 32.675.
                ' Very large values for NumDigitsAfterDecimals can cause an out-of-range error 
                ' when dividing.
                On Error Resume Next
                ScaledValue = Round(CDec(Value) * Scaling)
                ReturnValue = ScaledValue / Scaling
                If Err.Number <> 0 Then
                    ' Decimal overflow.
                    ' Round Value without conversion to Decimal.
                    ReturnValue = Round(Value * Scaling) / Scaling
                End If
            End If
        Else
            ' Standard 4/5 rounding.
            ' Very large values for NumDigitsAfterDecimals can cause an out-of-range error 
            ' when dividing.
            On Error Resume Next
            Half = CDec(0.5)
            If Value > 0 Then
                ScaledValue = Int(CDec(Value) * Scaling + Half)
            Else
                ScaledValue = -Int(-CDec(Value) * Scaling + Half)
            End If
            ReturnValue = ScaledValue / Scaling
            If Err.Number <> 0 Then
                ' Decimal overflow.
                ' Round Value without conversion to Decimal.
                Half = CDbl(0.5)
                If Value > 0 Then
                    ScaledValue = Int(Value * Scaling + Half)
                Else
                    ScaledValue = -Int(-Value * Scaling + Half)
                End If
                ReturnValue = ScaledValue / Scaling
            End If
        End If
        If Err.Number <> 0 Then
            ' Rounding failed because values are near one of the boundaries of type Double.
            ' Return value as is.
            ReturnValue = Value
        End If
    End If

    RoundMid = ReturnValue

End Function

整数値への丸め（小数点以下 n への丸めではない）について話している場合は、常に旧式の方法があります：

return int(var + 0.5)

（小数点以下 n でもこの機能を使用できますが、少し面倒になり始めます）

Lanceは、VBAの実装での継承丸めbugについて既に言及しました。 したがって、VB6アプリで実際の丸め関数が必要です。 ここに私が使用しているものがあります。コメントで示されているように、ウェブ上で見つけたものに基づいています。

' -----------------------------------------------------------------------------
' RoundPenny
'
' Description:
'    rounds currency amount to nearest penny
'
' Arguments:
'    strCurrency        - string representation of currency value
'
' Dependencies:
'
' Notes:
' based on RoundNear found here:
' http://advisor.com/doc/08884
'
' History:
' 04/14/2005 - WSR : created
'
Function RoundPenny(ByVal strCurrency As String) As Currency

         Dim mnyDollars    As Variant
         Dim decCents      As Variant
         Dim decRight      As Variant
         Dim lngDecPos     As Long

1        On Error GoTo RoundPenny_Error

         ' find decimal point
2        lngDecPos = InStr(1, strCurrency, ".")

         ' if there is a decimal point
3        If lngDecPos > 0 Then

            ' take everything before decimal as dollars
4           mnyDollars = CCur(Mid(strCurrency, 1, lngDecPos - 1))

            ' get amount after decimal point and multiply by 100 so cents is before decimal point
5           decRight = CDec(CDec(Mid(strCurrency, lngDecPos)) / 0.01)

            ' get cents by getting integer portion
6           decCents = Int(decRight)

            ' get leftover
7           decRight = CDec(decRight - decCents)

            ' if leftover is equal to or above round threshold
8           If decRight >= 0.5 Then

9              RoundPenny = mnyDollars + ((decCents + 1) * 0.01)

            ' if leftover is less than round threshold
10          Else

11             RoundPenny = mnyDollars + (decCents * 0.01)

12          End If

         ' if there is no decimal point
13       Else

            ' return it
14          RoundPenny = CCur(strCurrency)

15       End If

16       Exit Function

RoundPenny_Error:

17       Select Case Err.Number

            Case 6

18             Err.Raise vbObjectError + 334, c_strComponent & ".RoundPenny", "Number '" & strCurrency & "' is too big to represent as a currency value."

19          Case Else

20             DisplayError c_strComponent, "RoundPenny"

21       End Select

End Function
' ----------------------------------------------------------------------------- 

VBA.Round(1.23342, 2) // will return 1.23

ペニーの分割が元の分割量にならないという問題を解決するために、ユーザー定義関数を作成しました。

Function PennySplitR(amount As Double, Optional splitRange As Variant, Optional index As Integer = 0, Optional n As Integer = 0, Optional flip As Boolean = False) As Double
' This Excel function takes either a range or an index to calculate how to "evenly" split up dollar amounts
' when each split amount must be in pennies.  The amounts might vary by a penny but the total of all the
' splits will add up to the input amount.

' Splits a dollar amount up either over a range or by index
' Example for passing a range: set range $I$18:$K$21 to =PennySplitR($E$15,$I$18:$K$21) where $E$15 is the amount and $I$18:$K$21 is the range
'                              it is intended that the element calling this function will be in the range
' or to use an index and total items instead of a range: =PennySplitR($E$15,,index,N)
' The flip argument is to swap rows and columns in calculating the index for the element in the range.

' Thanks to: http://stackoverflow.com/questions/5559279/excel-cell-from-which-a-function-is-called for the application.caller.row hint.
Dim evenSplit As Double, spCols As Integer, spRows As Integer
If (index = 0 Or n = 0) Then
    spRows = splitRange.Rows.count
    spCols = splitRange.Columns.count
    n = spCols * spRows
    If (flip = False) Then
       index = (Application.Caller.Row - splitRange.Cells.Row) * spCols + Application.Caller.Column - splitRange.Cells.Column + 1
     Else
       index = (Application.Caller.Column - splitRange.Cells.Column) * spRows + Application.Caller.Row - splitRange.Cells.Row + 1
    End If
 End If
 If (n < 1) Then
    PennySplitR = 0
    Return
 Else
    evenSplit = amount / n
    If (index = 1) Then
            PennySplitR = Round(evenSplit, 2)
        Else
            PennySplitR = Round(evenSplit * index, 2) - Round(evenSplit * (index - 1), 2)
    End If
End If
End Function

次のシンプル関数を使用して、常に切り上げる当社と同様に、通貨を切り上げました。

Function RoundUp(Number As Variant)
   RoundUp = Int(-100 * Number) / -100
   If Round(Number, 2) = Number Then RoundUp = Number
End Function

ただし、これは常に小数点以下2桁に切り上げられ、エラーが発生することもあります。

負の値であっても切り上げます（-1.011は-1.01になり、1.011は1.02になります）

そのため、切り上げ（または負の場合は切り下げ）のオプションを追加するには、この機能を使用できます：

Function RoundUp(Number As Variant, Optional RoundDownIfNegative As Boolean = False)
On Error GoTo err
If Number = 0 Then
err:
    RoundUp = 0
ElseIf RoundDownIfNegative And Number < 0 Then
    RoundUp = -1 * Int(-100 * (-1 * Number)) / -100
Else
    RoundUp = Int(-100 * Number) / -100
End If
If Round(Number, 2) = Number Then RoundUp = Number
End Function

（モジュールで使用されている場合、それが明らかでない場合）

Access 2003で常に次の整数に切り上げる簡単な方法を次に示します。

BillWt = IIf([Weight]-Int([Weight])=0,[Weight],Int([Weight])+1)

例：

  • [重量] = 5.33; Int（[Weight]）= 5; 5.33-5 = 0.33（<！> lt; <！> gt; 0）、したがって、答えはBillWt = 5 + 1 = 6です。
  • [Weight] = 6.000、Int（[Weight]）= 6なので、6.000-6 = 0なので、答えはBillWt = 6です。
ライセンス： CC-BY-SA と 帰属
所属していません StackOverflow
scroll top