MS Access、VBAで丸める方法
-
02-07-2019 - |
質問
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、または有効数字(CodePlex)
GitHubでのコードのみ:
通常の丸め方法をカバーしています:
-
切り捨て、負の値をゼロに丸めるオプション
-
切り上げ、負の値をゼロから切り捨てるオプションを使用
-
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です。