quarta-feira, 21 de agosto de 2013

VBA - Função de arredondamento com incremento personalizado

Outro dia precisei de uma função para transformar 1,1 em 2 e assim por diante (arredondar para cima sempre que a decimal for maior que zero) e com a ajuda do grande mestre Gib@ que conseguiu garimpar no suporte da Microsoft, deixo aqui para futuras consultas, pois os materiais da Microsoft costumam mudar de lugar ou simplesmente sumir. O link original: http://support.microsoft.com/kb/155696/pt-br

O exemplo a seguir cria um procedimento chamado RoundToNearest, que aceita três parâmetros:

   Parameter     Value

   ---------     ---------------------------------------------------------

   Amt           The numeric value you want to round

   RoundAmt      The increment to which Amt will be rounded

   Direction     Constant indicating which direction to round (up or down)

                                  

Por exemplo, RoundToNearest (3,33, 0,1, vb_roundup) retorna o valor 3.4.

1.       Crie um módulo e digite as seguintes linhas na seção declarações:

2.             Option Explicit

3.             Public Const vb_roundup = 1

      Public Const vb_rounddown = 0

Observação: Versões 1. x e 2.0, use a palavra "Global" em vez de "Público".

4.       Crie o procedimento a seguir.

Observação: No código de exemplo a seguir, um sublinhado (_) ao final de uma linha é usado como um caractere de 
continuação de linha. Remova o sublinhado do final da linha quando recriar esse código no Access Basic.

5.             Function RoundToNearest (Amt As Double, RoundAmt As Variant, _

6.                                      Direction As Integer) As Double

7.                On Error Resume Next

8.                Dim Temp As Double

9.                Temp = Amt / RoundAmt

10.            If Int(Temp) = Temp Then

11.               RoundToNearest = Amt

12.            Else

13.               If Direction = vb_rounddown Then

14.                  Temp = Int(Temp)

15.               Else

16.                  Temp = Int(Temp) + 1

17.               End If

18.               RoundToNearest = Temp * RoundAmt

19.            End If

20.         End Function

                                                 

21.   Para testar essa função, digite cada uma das linhas a seguir na janela Depurar 
(ou janela Verificação imediata no 1. x e 2.0) e, em seguida, pressione ENTER.

? RoundToNearest (0.25, vb_roundup, 1.36)

Observe que o procedimento retorna 1.5.

? RoundToNearest (1.36, 0.05, vb_rounddown)

Observe que o procedimento retorna 1.35.

? RoundToNearest (1.36, 0.75, vb_roundup)

Observe que o procedimento retorna 1.5, que é dois incrementos de 0,75.

Observação: Para usar a função acima na propriedade OrigemDoControle de um controle em um formulário, 
você precisará substituir as constantes vb_roundup e vb_rounddown com seus valores de número inteiro.

Nenhum comentário:

Pesquisar este blog

Arquivo do blog

Quem sou eu

Minha foto
Administrador de Empresas/Técnico em Processamento de Dados. Microsoft Office User Specialist - Excel Proficient. Pós-graduado em Business Intelligence.