Notifications

Clear all

Função de extrair numero

2024 - VBA & Macros

Post Recente por Esdrinhas 9 anos atrás

7 Posts

3 Usuários

0 Reactions

2,006 Visualizações

RSS

Esdrinhas

(@esdrinhas)

Posts: 9

Active 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

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

Postado : 05/05/2016 8:34 am

Esdrinhas

(@esdrinhas)

Posts: 9

Active 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: 2749

Famed Member

Arquivo de exemplo

Marcelo Prudencio
Microsoft Excel Brasil no Facebook

"Começar já é a metade do caminho."
Autor Desconhecido

Simplifica que simples fica.
Nicole Tomazella.

"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.

Postado : 05/05/2016 9:42 am

Esdrinhas

(@esdrinhas)

Posts: 9

Active 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

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

Postado : 05/05/2016 10:51 am