Como redonda em MS Access, VBA
-
02-07-2019 - |
Pergunta
O que é a melhor maneira de rodada em VBA Access?
Meu método atual utiliza o método de Excel
Excel.WorksheetFunction.Round(...
Mas eu estou procurando um meio que não confiam em Excel.
Solução
Tenha cuidado, a função VBA Rodada usa o arredondamento do banqueiro, onde se arredonda .5 para um número par, assim:
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)
Considerando que a função de planilha do Excel redondas, sempre arredonda 0,5 cima.
Eu fiz alguns testes e parece que .5 para o arredondamento (arredondamento simétrico) também é usado pela célula formatação, e também para a largura da coluna arredondamento (quando se utiliza o formato de número Geral). O 'precisão conforme exibido' bandeira não parece fazer qualquer arredondamento em si, ele só usa o resultado arredondado do formato da célula.
Eu tentei implementar a função SymArith da Microsoft em VBA para o meu arredondamento, mas descobriu que Fix tem um erro quando você tenta dar-lhe um número como 58,55; a função dando um resultado de 58,5 em vez de 58,6. então eu finalmente descobri que você pode usar a função de planilha do Excel Rodada, assim:
Application.Round (58,55, 1)
Isto irá permitir que você faça o arredondamento normal em VBA, embora possa não ser tão rápido como alguns função personalizada. Sei que esta tem um círculo completo da questão, mas quis incluí-lo para ser completo.
Outras dicas
Para expandir um pouco sobre a resposta aceita:
"Os executa função rodada até mesmo, que é diferente da rodada para maior."
--Microsoft
Format sempre arredonda-se.
Debug.Print Round(19.955, 2)
'Answer: 19.95
Debug.Print Format(19.955, "#.00")
'Answer: 19.96
ACC2000: erros de arredondamento quando os números Você Use ponto-flutuante: http://support.microsoft.com/ kb / 210423
ACC2000: Como redonda um número para cima ou para baixo por um incremento desejado: http://support.microsoft .com / kb / 209996
Round Função: http://msdn2.microsoft.com/en-us /library/se6f2zfx.aspx
Como implementar procedimentos personalizados de arredondamento: http://support.microsoft.com/kb/196652
Na Suíça e na particulat no setor de seguros, temos que usar várias regras de arredondamento, dependendo se ele chash para fora, um benefício etc.
Eu uso atualmente a função
Function roundit(value As Double, precision As Double) As Double
roundit = Int(value / precision + 0.5) * precision
End Function
que parece funcionar bem
Int e Fix são funções de arredondamento úteis, que lhe dão a parte inteira de um número.
Int sempre rodadas para baixo - Int (3,5) = 3, Int (-3,5) = -4
Fix sempre rodadas para zero - Fix (3,5) = 3, Fix (-3,5) = -3
Há também as funções de coerção, em especial CInt e CLng, que tentam coagir um número para um tipo inteiro ou um tipo long (inteiros estão entre -32.768 e 32.767, longs são entre-2147483648 e 2147483647). Estes dois programas rodada para o número inteiro mais próximo, arredondamento longe de zero a partir de 0,5 -. CInt (3.5) = 4, Cint (3,49) = 3, CInt (-3,5) = -4, etc
1 place = INT(number x 10 + .5)/10
3 places = INT(number x 1000 + .5)/1000
e assim on.You'll muitas vezes achamos que soluções aparentemente kludgy como este são muito mais rápido do que usar as funções do Excel, porque o VBA parece operar em um espaço de memória diferente.
por exemplo If A > B Then MaxAB = A Else MaxAB = B
é de cerca de 40 x mais rápido que usar ExcelWorksheetFunction.Max
Infelizmente, as funções nativas do VBA que podem executar o arredondamento estão ausentes, limitado, imprecisas ou de buggy, e cada endereços apenas um único método de arredondamento. A vantagem é que eles são rápidos, e que possam, em algumas situações ser importante.
No entanto, muitas vezes a precisão é obrigatória, e com a velocidade dos computadores de hoje, um processamento pouco mais lento dificilmente será notado, certamente não para o processamento de valores individuais. Todas as funções nos links abaixo prazo em cerca de 1 mS.
O conjunto completo de funções - para todos os métodos comuns de arredondamento, todos os tipos de dados de VBA, para qualquer valor, e não retornar valores inesperados - pode ser encontrada aqui:
arredondamento valoriza-se, para baixo, por 4/5, ou de números significativos (EE)
ou aqui:
arredondamento valoriza-se, para baixo, por 4/5, ou para números significativos (CodePlex)
Código somente no GitHub:
Eles cobrem os métodos de arredondamento normais:
-
Round para baixo, com a opção de valores negativos redondas para zero
-
Round-se, com a opção de valores negativos redondos longe de zero
-
Round por 4/5, seja longe de zero ou até mesmo (de Banker arredondamento)
-
Round a uma contagem de algarismos significativos
As três primeiras funções aceitar todos os tipos de dados numéricos, enquanto o último existe em três variedades -. Para Moeda, Decimal, e duas vezes, respectivamente
Eles todos aceitam a contagem especificada de casas decimais - incluindo uma contagem negativa que será rodada a dezenas, centenas, etc. Aqueles com Variant como o tipo de retorno irá retornar nulo para a entrada incompreensível
Um módulo de teste para teste e validação também está incluída.
Um exemplo é aqui - para o comum 4/5 arredondamento. Por favor, estude os comentários in-line para os detalhes sutis e da maneira CDec é usado para erros evitar bit.
' 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
Se você está falando sobre o arredondamento para um valor inteiro (e não o arredondamento para n casas decimais), há sempre a maneira da velha escola:
return int(var + 0.5)
(Você pode fazer este trabalho para n casas decimais também, mas ele começa a ficar um confuso bit)
Lance já mencionado a herdar arredondamento bug
na implementação do VBA.
Então eu preciso de uma função de arredondamento real em um aplicativo VB6.
Aqui está um que eu estou usando. Ele é baseado no que eu encontrei na web como é indicado nos comentários.
' -----------------------------------------------------------------------------
' 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
Para resolver o problema de divisões moeda de um centavo não somando o montante que eles foram originalmente separou, eu criei uma função definida pelo usuário.
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
Eu usei o seguinte simples Função para arredondar minhas moedas como em nossa empresa, temos sempre -se round.
Function RoundUp(Number As Variant)
RoundUp = Int(-100 * Number) / -100
If Round(Number, 2) = Number Then RoundUp = Number
End Function
Mas isso vai-se SEMPRE rodada para 2 casas decimais e podem também erro.
mesmo que seja negativa vai arredondar para cima (-1,011 será -1.01 e 1.011 será 1,02)
de modo a fornecer mais opções para arredondamento para cima (ou para baixo para negativo) você poderia utilizar esta função:
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
(usado em um módulo, se não é óbvio)
Aqui é fácil maneira de se sempre volta para o próximo número inteiro no Access 2003:
BillWt = IIf([Weight]-Int([Weight])=0,[Weight],Int([Weight])+1)
Por exemplo:
- [Peso] = 5,33; Int ([Peso]) = 5; assim 5,33-5 = 0,33 (<> 0), de modo que resposta é BillWt = 5 + 1 = 6.
- [Peso] = 6,000, Int ([Peso]) = 6, de modo 6,000-6 = 0, de modo que resposta é BillWt = 6.