Função para extrair números de células

Objetivo: Apresentar uma função criada para extrair somente números de células que contenham dados mistos, como por exemplo em históricos contábeis.

 

Um problema que a leitora Mônica S.P. me enviou por e-mail, foi a dificuldade de realizar a conciliação de dados utilizando a base que ela tinha, que possuia dados mistos, aos quais não havia a possibilidade de separar em colunas, isto é típico de históricos contábeis, principalmente lançamentos manuais.

Desta forma criei uma função que realiza a extração dos números de células utilizando o VBA abaixo:

'
'Esta função tem por objetivo retirar números de células que contenham conteúdos mistos de números e texto
'sem a possibilidade de serem colunados
Public Function lfRetiraNumeros(ByVal vValor As String) As String
    'Atualiza o cálculo automaticamente
    Application.Volatile
    
    'Conta a quantidade de caracteres
    Dim vQtdeCaract As Long
    Dim vControle   As Boolean
    
    vQtdeCaract = Len(vValor)
    vControle = False
    
    'Para cada caractere identifica se é número ou texto
    For i = 1 To vQtdeCaract
        'Se for número adiciona no retorno da função
        If IsNumeric(Mid(vValor, i, 1)) Then
            If vControle = True And lfRetiraNumeros  vbNullString Then
                lfRetiraNumeros = lfRetiraNumeros + " "
            End If
            vControle = False
            lfRetiraNumeros = lfRetiraNumeros & Mid(vValor, i, 1)
        Else
            vControle = True
        End If
    Next
    
    'Substitui espaços em branco por / e tira espaços em branco no final do retorno da função
    lfRetiraNumeros = Replace(Trim(lfRetiraNumeros), " ", "/")

End Function

 

Para utilizar esta macro você pode usar direto nesta planilha disponibilizada ou ainda colocá-la nas suas funções globais, conforme o artigo: http://guiadoexcel.com.br/criando-funcoes-proprias-globais#more-141.

E depois para utilizá-la basta digitar =lfRetiraNumeros(B2) e substituir o B2 pelo endereço da célula ou texto que desejar.

Baixe a planilha

Abraço

Marcos Rieper