Código VBA para retirar dois caracteres de um número

[Marco_Bertolani]

Olá,

Tenho uma planilha com 5000 linhas com números que iniciam com dois zeros e possuem mais 18 caracteres (ex: 00343567542788905412). Preciso de um código VBA para retirar os dois zeros da coluna inteira, ou seja, das 5000 linhas, e deixar somente os 18 caracteres seguintes (ex: 343567542788905412). Alguém pode me ajudar?

Abs!

Marco.

[webmaster]

Marco,

Não é preciso VBA, se for o caso. Tente esta fórmula:

Código: Selecionar todos

=TIRAR(SUBSTITUIR(ARRUMAR(SUBSTITUIR(A1 & CARACT(9);"0";" "));" ";"0"))

Testei aqui com número com vários zeros a esquerda e funcionou. Só haverá problemas se os números tiverem muitos zeros à direita.

Abraços

[Nei Stolberg]

Olá amigo,

Se os números tiverem sempre as mesmas quantidades de caracteres, creio que isso pode ajudar:

Sub RetirarZeros()

L = 1
Do
If Sheets("Plan1").Cells(L, 1).Value <> "" Then
NovoValor = Mid(Sheets("Plan1").Cells(L, 1).Value, 3, 20)
Sheets("Plan1").Cells(L, 1).Value = NovoValor
L = L + 1
Else
Parar = 1
End If
Loop Until Parar = 1

End Sub

Valeu..
Nei.

[webmaster]

Marco,

Cheguei num código aqui que deve resolver:

Código: Selecionar todos

Public Function RemoverZerosEsquerda(ByVal textoCelula As String) As String
    'converte em array
    Dim caracteresCelula() As String
    caracteresCelula = Split(StrConv(textoCelula, vbUnicode), Chr$(0))
    ReDim Preserve caracteresCelula(UBound(caracteresCelula) - 1)
    'conta quantos zeros têm no começo
    Dim zeros As Integer
    zeros = 0
    For Each c In caracteresCelula
        If c = "0" Then
            zeros = zeros + 1
        Else
            'quando não achar mais, pára
            Exit For
        End If
    Next c
    
    RemoverZerosEsquerda = Right(textoCelula, Len(textoCelula) - zeros)
End Function

Abraços

[Marco_Bertolani]

Perfeito!!! Grato!!!

Olá amigo,

Se os números tiverem sempre as mesmas quantidades de caracteres, creio que isso pode ajudar:

Sub RetirarZeros()

L = 1
Do
If Sheets("Plan1").Cells(L, 1).Value <> "" Then
NovoValor = Mid(Sheets("Plan1").Cells(L, 1).Value, 3, 20)
Sheets("Plan1").Cells(L, 1).Value = NovoValor
L = L + 1
Else
Parar = 1
End If
Loop Until Parar = 1

End Sub

Valeu..
Nei.

[Marco_Bertolani]

Muito obrigado!!!!!!!!!!

Marco,

Cheguei num código aqui que deve resolver:

Código: Selecionar todos

Public Function RemoverZerosEsquerda(ByVal textoCelula As String) As String
    'converte em array
    Dim caracteresCelula() As String
    caracteresCelula = Split(StrConv(textoCelula, vbUnicode), Chr$(0))
    ReDim Preserve caracteresCelula(UBound(caracteresCelula) - 1)
    'conta quantos zeros têm no começo
    Dim zeros As Integer
    zeros = 0
    For Each c In caracteresCelula
        If c = "0" Then
            zeros = zeros + 1
        Else
            'quando não achar mais, pára
            Exit For
        End If
    Next c
    
    RemoverZerosEsquerda = Right(textoCelula, Len(textoCelula) - zeros)
End Function

Abraços

[Marco_Bertolani]

Obrigado!!!!!!!!!!

Marco,

Não é preciso VBA, se for o caso. Tente esta fórmula:

Código: Selecionar todos

=TIRAR(SUBSTITUIR(ARRUMAR(SUBSTITUIR(A1 & CARACT(9);"0";" "));" ";"0"))

Testei aqui com número com vários zeros a esquerda e funcionou. Só haverá problemas se os números tiverem muitos zeros à direita.

Abraços