MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access


3 participantes

    Arredondamento de casas decimais

    avatar
    fazerbem
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 421
    Registrado : 05/03/2017

    Arredondamento de casas decimais Empty Arredondamento de casas decimais

    Mensagem  fazerbem 6/1/2022, 11:53

    Eu tenho uma caixa de texto Resultado que me fornece a soma de outras caixas de texto. Desta forma queria ter uma outa caixa de texto com uma fórmula automática que pegasse o resultado da Caixa Resultado e arredondasse o valor para mais intermediário ou menos. Da seguinte maneira.

    Resultado = 123.34
    Resultado corrigido = 123.30. (menos)

    Resultado = 123.35
    Resultado corrigido = 123.35 (não altera)

    Resultado = 123.36
    Resultado corrigido = 123.40 (mais)

    Ou seja, nos centavos arredondar para mais ou menos somente o último número

    Obrigado

    PS: Nao consegui entender aqui
    dropbox.com/s/3gz7acv2m0zpeox/ArredondarUmValor.txt?dl=1
    Código:
    Funções Arredondar

    'Arredonda para mais 0,5 ou menos 0,5

    Function Round(dblNumber As Double, IntDecimais As Integer) As Double
    Dim dblfator As Double
    Dim dblTemp As Double
    dblfator = 10 ^ IntDecimais
    dblTemp = dblNumber * dblfator + 0.5
    Round = Int(dblTemp) / dblfator
    End Function



    'Arredonda para mais 1

    Function arredondar(numero As Double) As Double
    'By JPaulo :registered: Maximo Access
        If numero - Int(numero) > 0 Then
            arredondar = Int(numero) + 1
            Else: arredondar = numero
        End If
    End Function


    'Arredonda para inteiros de 5

    Public Function Arredonda(varNumero As Variant) As Long
    'By JPaulo :registered: Maximo Access
    On Error Resume Next
    If IsNumeric(varNumero) Then
    Arredonda = -Int(-varNumero / 5) * 5
    End If
    End Function


    'Arredonda para inteiros de 0

    Public Function Arredonda(varNumero As Variant) As Long
    'By JPaulo :registered: Maximo Access
    On Error Resume Next
    If IsNumeric(varNumero) Then
    Arredonda = -Int(-varNumero / 10) * 10
    End If
    End Function
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7476
    Registrado : 15/03/2013

    Arredondamento de casas decimais Empty Re: Arredondamento de casas decimais

    Mensagem  ahteixeira 7/1/2022, 12:46

    Olá André,

    O que pretende é arredondar de .05 em .05, para isso cole o código abaixo num módulo novo:

    Código:
    Public Function Arredonda05(varNumero As Variant) As Double
    'ahteixeira para maximoaccess em 07-01-2022
    'arredondar de .05 em .05

    Dim tmpNum As Double, iPos As Integer
    On Error Resume Next

        If IsNumeric(varNumero) Then
            tmpNum = Round(varNumero, 2)
            iPos = Right(tmpNum, 1)
            
            If iPos = 0 Or iPos = 5 Then
            Debug.Print tmpNum
                Arredonda05 = Round(tmpNum, 2)
            Else
                Arredonda05 = Round(tmpNum, 1)
            End If
        End If
    End Function

    Para chamar a função, pode ser diretamente com o valor:

    =Arredonda05(123.36)

    ou com nome de campo:
    =Arredonda05([CampoComValor])

    Abraço
    scandinavo
    scandinavo
    Super Avançado
    Super Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 934
    Registrado : 11/11/2009

    Arredondamento de casas decimais Empty Re: Arredondamento de casas decimais

    Mensagem  scandinavo 7/1/2022, 17:32

    fiz uns monstrinho aqui que também funciona

    colocar após atualizar do ultimo campo a ser preenchido para o calculo


    Código:
    Dim k
    Dim R As Double
    Dim E As Integer
    Dim D As Integer
    R = Me.txt1 / Me.txt2 'resultado da divis?o

    Me.txtResultado = Me.txt1 / Me.txt2
    'separando os numeros
    k = Split((Round((R), 2)), ",") 'faz o arrendondamento dos digitos ate a segunda casa

    E = Left(k(1), 1) 'Primeiro digito depois da virgula
    D = Right(k(1), 1) 'Segundo digito depois da virgula

    Select Case D
    Case Is = "0", "1", "2", "3", "4" 'se o segundo numero for 0 a 4 o segundo digito ? 0
    Me.txtRsArredondado = k(0) & "," & E & 0  'Remonta o numero
    Case Is = "6", "7", "8" 'se o segundo numero for 6 a 8 soma 1 ao primeiro digito
    Me.txtRsArredondado = k(0) & "," & E + 1 & 0 'Remonta o numero
    Case Is = "9" 'se o segundo numero for 9 soma 1 a parte inteira do numero
    Me.txtRsArredondado = k(0) + 1 & "," & 0 'Remonta o numero
    Case Else 'se o segundo numero for 5 nao altera o numero
    Me.txtRsArredondado = k(0) & "," & k(1) 'Remonta o numero
    End Select
    avatar
    fazerbem
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 421
    Registrado : 05/03/2017

    Arredondamento de casas decimais Empty Re: Arredondamento de casas decimais

    Mensagem  fazerbem 7/1/2022, 20:29

    Muito obrigado aos colegas, pelas sugestões.apresentadas.
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7476
    Registrado : 15/03/2013

    Arredondamento de casas decimais Empty Re: Arredondamento de casas decimais

    Mensagem  ahteixeira 23/4/2022, 18:06

    Olá a todos,

    André, se ficou esclarecido, não se esqueça de dar o tópico como Resolvido, veja como fazer:
    https://www.maximoaccess.com/t860-resolucao-de-topicos

    Abraço

    Conteúdo patrocinado


    Arredondamento de casas decimais Empty Re: Arredondamento de casas decimais

    Mensagem  Conteúdo patrocinado


      Data/hora atual: 19/5/2022, 00:36