criando FUNÇÃO "RetirarNumero()" no Excel (VBA)

Para extrair os números de uma célula que contenha dados mistos (letras e números) o Excel tem várias funções nativas, porém todas elas são limitadas a uma série de regras e combinações que muitas vezes só complicam vejam Fórmula para extrair número de texto - EXCEL.

Para simplificar a vida do usuário Excel, vamos criar uma função através do VBA para extrair todo valor numérico de uma célula que tenha texto com números junto.

Nesta função o(s) números(s) podem estar em qualquer posição da célula, a função irá reconhecer e trazer a informação.

Copie esta macro e cole no módulo do VBA , vá em inserir função , função definida pelo usuário e pronto.

Function RetirarNumero(Texto As String)
   Dim x As Integer
   Dim y As Integer
   Dim z As String
   For x = Len(Texto) To 1 Step -1
   If IsNumeric(Mid(Texto, x, 1)) Then
     y = y + 1
     z = Mid(Texto, x, 1) & z
   End If
   If y = 1 Then z = CInt(Mid(z, 1, 1))
     Next x
     RetirarNumero = CLng(z)
 End Function

Neste exemplo de função ela será usada com a seguinte sintaxe na célula onde se queira o resultado:

=retirarnumero(end_celula)

end_celula:  é o endereço físico da célula  exemplo:  =retirarnumero(a1)

Vamos no passo a passo para criar esta função:

1º) O arquivo Excel deverá ser salvo para execução de macro, ou seja, "Pasta de Trabalho Habilitada para Macro do Excel"

2º) A pasta de "Desenvolvedor", precisa estar disponível como na imagem abaixo:

Se esta pasta não estiver habilitada siga a instrução abaixo para habilita-la.

ARQUIVO

     OPÇÕES

          Personalizar Faixa de Opções

no lado direito tem uma relação de opções para Guias Principais, habilite DESENVOLVEDOR

3º) Após habilitado esta pasta, vamos inserir o código VBA.

CLICK no icone Visual Basic na extrema esquerda para abrir o editor

4º) Vamos editar o VBA e criar a função

Na tela de edição abra a tela de projeto VBA (EXIBIR / PROJECT EXPLORER)

Aberta a tela de projeto, insira um Módulo em Plan1

Na tela de código que será aberta insira :

Function RetirarNumero(Texto As String)
Dim x As Integer
Dim y As Integer
Dim z As String
For x = Len(Texto) To 1 Step -1
If IsNumeric(Mid(Texto, x, 1)) Then
y = y + 1
z = Mid(Texto, x, 1) & z
End If
If y = 1 Then z = CInt(Mid(z, 1, 1))
Next x
RetirarNumero = CLng(z)
End Function

Logo após inserir os comandos é só salvar...

Pode fechar esta janela e voltar a planilha de trabalho.

6º) Na célula onde deseja o resultado insira a nova FUNÇÃO...

Fonte pesquisa internet para desenvolvimento deste documento.