怎么轮MS Access，VBA
https://stackoverflow.com/questions/137114
-
02-07-2019 - |
italiano
english
français
española
中国
日本の
العربية
Deutsch
한국어
Português
Russian题
什么是最好的方式来圆VBA访问？
我目前的方法利用Excel的方法
Excel.WorksheetFunction.Round(...
但是我在寻找一种手段，不依赖于Excel。
解决方案
小心，VBA Round函数使用Banker的舍入，它将.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工作表功能回合，总是向上舍入.5。
我已经完成了一些测试，它看起来像.5向上舍入（对称舍入）也用于单元格格式化，也用于列宽舍入（当使用常规数字格式时）。 '精确显示'标志似乎不会进行任何舍入，它只使用单元格格式的舍入结果。
我尝试在VBA中实现Microsoft的SymArith功能进行舍入，但是当你试图给它一个像58.55这样的数字时，发现Fix有错误。函数给出58.5而不是58.6的结果。然后我终于发现你可以使用Excel工作表Round函数，如下所示：
Application.Round（58.55,1）
这将允许您在VBA中进行正常的舍入，尽管它可能不如某些自定义函数快。我意识到问题已经完全循环，但是想要将其包括在内以便完整。
其他提示
在接受的答案上稍微扩展一下：
<！>“Round函数执行round到even，这不同于round到big。<！>;
--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
修复始终向零舍入 - 修复（3.5）= 3，修复（-3.5）= -3
还有强制函数，特别是CInt和CLng，它们试图将数字强制转换为整数类型或长整数类型（整数在-32,768和32,767之间，长度在-2,147,483,648和2,147,483,647之间）。这些将朝着最接近的整数舍入，从零开始四舍五入到.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
例如If A > B Then MaxAB = A Else MaxAB = B比使用ExcelWorksheetFunction.Max
不幸的是，该机功能的VBA，可以执行四舍五入的缺失，有限的、不准确、或越野车，并且每个地址只有一个单一的四舍五入方法。这倒是他们是快速的，并且可能在某些情况下是重要的。
但是，往往精确是强制性的，并用计算机的速度今天，慢一点处理几乎不会被注意到，事实上，不处理的单一数值。所有功能在下面的链接运行，在大约1微秒。
一整套的职能为所有共同四舍五入方法，所有的数据类型的VBA，对于任何价值，而不返回的意想不到的价值观可以在这里找到：
或在这里：
代码，只有在审查:
它们复盖的正常四舍五入方法：
轮下来，可以选择一轮的负面价值观对零
圆圆的，有选择圆负值，从零
轮4/5，无论是从零或甚至(银行家的四舍五入)
轮到的一个最重要的数字
第三种功能接受所有的数字数据类型，而最后一个存在三种货币、小数和双重分别。
他们都接受指定的最小数，包括负数，这将轮到几十、几百、等等。那些变异作为回报类将返回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
（在模块中使用，如果不明显的话）
这里是简单的方法来始终轮到下一个整数在2003年访问:
BillWt = IIf([Weight]-Int([Weight])=0,[Weight],Int([Weight])+1)
例如：
- [量]=5.33;Int([重量])=5;所以5.33-5=0.33(<>0)，所以答案是BillWt=5+1=6.
- [量]=6 000个,Int([重量])=6，使6 000个-6=0，所以答案是BillWt=6.
