Macro separação dec...
 
Compartilhar:
Notifications
Clear all

Macro separação decimal no separador de milhar


guma.cojogra
Posts: 6
Registered
Topic starter
(@guma-cojogra)
Active Member
Entrou: 2 anos atrás

Bom dia

o meu sistema gera um relatório tipo extrato bancário onde os números negativos vem acompanhados por um D e os positivos por um C Criei a seguinte macro para formatar esses valores para número.

Mas a mesma está invertendo o separador de decimal pelo separador de milhar ou seja ela coloca a virgula onde fica o ponto.

Exemplo se o número for 1.000,00D  fica -1,00

se tirar o ponto ex 1000,00D fica -100000,00

já mexi na configuração do Excel e não adiantou.

 

Sub Ajustar_Valores()
    
    Dim r As range
 
    
    Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
      
    Application.Volatile
    For Each r In Selection
    
    
        If Right(r.Text, 1) = "D" Then
        
      r.Value = Val(Left(r.Text, Len(r.Text) - 1)) * -1
        
        Else
        
     r.Value = Val(Left(r.Text, Len(r.Text) - 1))
     
        End If
        
    
    Next r
        
        
End Sub
Responder
Tags do Tópico
2 Respostas
DJunqueira
Posts: 96
Registered
(@dmorais)
Trusted Member
Entrou: 8 meses atrás

Muitas vezes vc pode resolver isso de forma sistemática pelo Power Query.

 

Propriedade Application.DecimalSeparator (Excel)

Responder
Celso Yano
Posts: 2
Registered
(@celso-yano)
New Member
Entrou: 11 anos atrás

Boa tarde. Tenta isso ...

Sub Ajustar_Valores()
    
Dim r As Range
Dim var1 As Variant
Dim var2 As Double

    For Each r In Selection
        var1 = Replace(r.Value, " ", "")
        
        If Right(var1, 1) = "D" Then
            var1 = Replace(var1, "D", "")
            var2 = -(var1 * 1)
        Else
            var1 = Replace(var1, "C", "")
            var2 = var1 * 1
            
        End If
        
        r.Value = var2
        r.NumberFormat = "#,##0.00"
        
    Next r

End Sub
Responder
Compartilhar: