Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Função de extrair n...
 
Notifications
Clear all

Função de extrair numero

 
2024 - VBA & Macros
Post Recente por Esdrinhas 8 anos atrás
7 Posts
3 Usuários
0 Reactions
1,988 Visualizações
RSS
 Esdrinhas
(@esdrinhas)
Posts: 0
New Member
Topic starter
 

Olá, tenho a seguinte funcão

Function Numeros(Texto As String)
For Num = 1 To Len(Texto)
If Mid(Texto, Num, 1) <= 9 Then
Numeros = Numeros + Mid(Texto, Num, 1)
End If
Next
End Function


Para Adicionar para todas a planilhas:

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

Preciso que ela extrai de uma celula somente valores , no qual essa celula esta assim 

SAO JJ BSB G3 RIO 0.00 G3 SSA JJ NYC 240.00

Gostaria que extraisse assim , 

0.00  240.00

porem extrai assim , 

00024000

o ponto é desconsiderado e tambem, junta todo os valores...
Obrigado.

 
Postado : 05/05/2016 8:17 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bom dia Esdrinhas,

Seja bem vindo ao fórum.

Vê se ajuda:

Option Explicit

Public Function ExtractNumber(ByVal Campo As String) As String
Dim ValueNumeric    As String
Dim Validator()     As String
Dim ValidCount      As Long
Dim i               As Long


    Validator = Split(Campo, " ")
    ValidCount = Application.WorksheetFunction.CountA(Validator)
    
    For i = 0 To ValidCount - 1
        If IsNumeric(Validator(i)) Then
            ValueNumeric = ValueNumeric & " " & Validator(i)
        End If
    Next i

    ExtractNumber = Trim(ValueNumeric)

End Function

Qualquer coisa da o grito.
Abraço

 
Postado : 05/05/2016 8:34 am
 Esdrinhas
(@esdrinhas)
Posts: 0
New Member
Topic starter
 

cara ajudou , porem essas informações sao muito relativas por exemplos. ela pode vir assim
SAO JJ BSB G3 RIO0.00 G3 SSA JJ NYC240.00

Com os valores junto ao texto entende?, eai no validador ele n vai pegar , pq precisa do espaço :/

 
Postado : 05/05/2016 9:07 am
 MPrudencio
(@mprudencio)
Posts: 0
New Member
 

Arquivo de exemplo

 
Postado : 05/05/2016 9:42 am
 Esdrinhas
(@esdrinhas)
Posts: 0
New Member
Topic starter
 

gostaria que fosse em forma de função

 
Postado : 05/05/2016 9:51 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Eu não chamaria de "informações muito relativas", isso eu chamo de "Ausência de padronização no cadastro das informações".

Nesse caso é totalmente diferente. Tenta assim:

Option Explicit

Public Function ExtractNumber(ByVal Campo As String) As String
Dim ValueNumeric    As String
Dim Counter         As Long
Dim i               As Long
Dim j               As Long

    Counter = Len(Campo)
    
    For i = Counter To 4 Step -1
        If IsNumeric(Mid(Campo, i - 1, 2)) And Mid(Campo, i - 2, 1) = "." Then
            ValueNumeric = Mid(Campo, i - 2, 3) & ValueNumeric
            For j = i - 3 To 1 Step -1
                If IsNumeric(Mid(Campo, j, 1)) Then
                    ValueNumeric = Mid(Campo, j, 1) & ValueNumeric
                    Else: Exit For
                End If
            Next j
            ValueNumeric = " " & ValueNumeric
        End If
    Next i
    
    ExtractNumber = Trim(ValueNumeric)

End Function

Qualquer coisa da o grito.
Abraço

 
Postado : 05/05/2016 10:51 am
 Esdrinhas
(@esdrinhas)
Posts: 0
New Member
Topic starter
 

Cara valeu , era exatamente oque eu queria
Valeu!

 
Postado : 05/05/2016 12:19 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico