Obtener solo los numeros de un string

[lucius]

Digamos que tengo esta cadena 452FH3.34-F0 como recuperaria solo los numeros osea 4523340, que funcion debo utilizar.

[wolf_kof]

es facil

Código: (vb) [Seleccionar]


dim Vi as integer
dim NNN, LLL, LL as string

LL = "El valor que le quieras dar"

    For Vi = 1 To Len(LL)
        LLL = Mid$(LL, Vi, 1)
        If LLL = "1" Then NNN = NNN & LLL
        If LLL = "2" Then NNN = NNN & LLL
        If LLL = "3" Then NNN = NNN & LLL
        If LLL = "4" Then NNN = NNN & LLL
        If LLL = "5" Then NNN = NNN & LLL
        If LLL = "6" Then NNN = NNN & LLL
        If LLL = "7" Then NNN = NNN & LLL
        If LLL = "8" Then NNN = NNN & LLL
        If LLL = "9" Then NNN = NNN & LLL
        If LLL = "0" Then NNN = NNN & LLL
    Next

' NNN sera el resultado en numeros



[Psyke1]

@wolf_kof
Probablemente esa sea la peor forma que hay...

@lucius
Te hice estas funciones:

Forma clásica:

Código: (vb) [Seleccionar]

Option Explicit
 
Private Sub Form_Load()
    Debug.Print Only_Numbers("hola1 ¿que34 tal538?")
End Sub
 
Public Function Only_Numbers(ByRef sText As String) As String
Dim sActualChar                 As String * 1
Dim lTotalChar                  As Long
Dim x                           As Long
    lTotalChar = LenB(sText) \ 2
    If CBool(lTotalChar) Then
        For x = 1 To lTotalChar
            sActualChar = Mid$(sText, x, 1)
            If IsNumeric(sActualChar) Then Only_Numbers = Only_Numbers & sActualChar
        Next
    End If
End Function
Forma avanzada:

Código: (vb) [Seleccionar]

Option Explicit
Option Base 0

Private Declare Function ArrayPtr Lib "msvbvm60" Alias "VarPtr" (ByRef Ptr() As Any) As Long
Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal Ptr As Long, ByVal Value As Long)

Private Function GetNumbersByString(ByRef sText As String) As String
Dim intAsc()                                    As Integer
Dim lngAscHeader(5)                             As Long
Dim lngPos                                      As Long
Dim lngTextLen                                  As Long

    lngTextLen = LenB(sText) \ 2
    If lngTextLen > 1 Then

        lngAscHeader(0) = &H1
        lngAscHeader(1) = &H2
        lngAscHeader(3) = StrPtr(sText)
        lngAscHeader(4) = lngTextLen
        PutMem4 ArrayPtr(intAsc), VarPtr(lngAscHeader(0))
       
        Do Until lngPos = lngTextLen
            Do
                If intAsc(lngPos) < 48 Then Exit Do
                If intAsc(lngPos) > 57 Then Exit Do
                GetNumbersByString = GetNumbersByString + CStr(intAsc(lngPos) - 48)
                lngPos = lngPos + 1
            Loop Until lngPos = lngTextLen
           
            lngPos = lngPos + 1
        Loop
        PutMem4 ArrayPtr(intAsc), 0
    End If
End Function

Código: (vb6) [Seleccionar]

Private Sub Form_Load()
Const s                     As String = "que 345 vivan 09453 las456 r4n4s"

    Debug.Print GetNumbersByString(s)
   
End Sub
Resultado:

Código: [Seleccionar]

3450945345644

Tambien podria hacerlo con RegExp...
Creo que me merezco un +1...
jajajajaja
Nah, en serio, espero que te sirva

DoEvents!

[ssccaann43]

Wao rana, te lo has currao tio...! Excelente...! Necesitare de tus ranaconocimientos pronto, te aviso...!

[YAcosta]

Pero porque tanto codigo para lo que han pedido???

Código: (vb) [Seleccionar]

LL = "4234ABC45"

For i = 1 To Len(LL)
   If IsNumeric(Mid(LL, i, 1)) Then
      a = a & Mid(LL, i, 1)
   End If
Next i

MsgBox (aa)

rana igual te di un +1

[Psyke1]

Ya YvanB, solo ponía varias opciones...
Tu forma es igual que la mia (versión clásica).
Gracias por el +1

DoEvents!

[raul338]

@wolf_kof
Probablemente esa sea la peor forma que hay...

No seas tan malo, lo que hizo es exactamente igual que la tuya, es lo que habrias pensado en forma de algoritmo y lo traspaso

[Psyke1]

@wolf_kof
Probablemente esa sea la peor forma que hay...

No seas tan malo, lo que hizo es exactamente igual que la tuya, es lo que habrias pensado en forma de algoritmo y lo traspaso

Él sabe que no lo dije a mal, somos buenos amigos, solo era una apreciación...

Pero porque tanto codigo para lo que han pedido???
...

Tambien lo digo por esto:
Tu forma de hacerlo vs mis funciones (de tanto código )
Probado con cadenas cortas no hay mucha diferencia, pero con una cadena muy larga(100000 carácteres) si que la hay...

Código: [Seleccionar]

Mr.Frog -->4,785 msec
YvanB   -->32,431 msec

DoEvents!

[YAcosta]

Ya YvanB, solo ponía varias opciones...
Tu forma es igual que la mia (versión clásica).
Gracias por el +1

DoEvents!

No papaa todo bien, por eso el +1, y si pudiera pondria mas. Si, mis formas son igual a las tuyas jejejej.

No el segundo codigo si es alucinantes, excelente, y correcto que para cadenas largas es mejor el segundo.

[LeandroA]

Hola te paso dos variantes mas

Código: (Vb) [Seleccionar]

Option Explicit

Private Sub Form_Load()
    MsgBox ExtraerNumeros("452FH3.34-F0")
    MsgBox ExtraerNumeros2("452FH3.34-F0")
End Sub


Private Function ExtraerNumeros(ByVal sCadena As String) As String
    Dim i As Long
    Dim sChr As String
   
    For i = 1 To Len(sCadena)
        sChr = Mid$(sCadena, i, 1)
        Select Case sChr
            Case 0 To 9
                ExtraerNumeros = ExtraerNumeros & sChr
        End Select
    Next
End Function

Private Function ExtraerNumeros2(ByVal sCadena As String) As String
    Dim i As Long
    Dim sChr As String
   
    For i = 1 To Len(sCadena)
        sChr = Mid$(sCadena, i, 1)
       If IsNumeric(sChr) Then
            ExtraerNumeros2 = ExtraerNumeros2 & sChr
        End If
    Next
End Function


[LeandroA]

huyyy cualquiera me mande, vi solo la respuesta de wolf_kof son iguales a las que ya pusieron.

[ssccaann43]

La Rana es un adicto sin retorno del VB...! Me gusta su vicio..!

[YAcosta]

huyyy cualquiera me mande, vi solo la respuesta de wolf_kof son iguales a las que ya pusieron.

A mi me paso exactamente lo mismo con el ejemplo de MrFrog pero no lo comente pq pensé que nadie me creeria. Su codigo no lo lei me fui de largo y cuando dije "codigo largo" lo hacia por la primera respuesta, o sea de mi amigo wolf. Pero igual, toy con roche jejejeje

dulces besos

[erbuson]

Hola, ya puestos a poner posibilidades, esta es un 30% más rapida que el IsNumeric, pero ojo estamos hablando para hacer la prueba de un bucle de 200.000

Código: (vb) [Seleccionar]

Private Function LosNumeros(Cadena As String) As String
  Dim c As Integer
  For c = 1 To Len(Cadena)
    If InStr("1234567890", Mid$(Cadena, c, 1)) Then LosNumeros = LosNumeros & Mid$(Cadena, c, 1)
  Next
End Function

Saludos

[wolf_kof]

 

dulces besos

 

Gracias por los animos, mi funcion puede ser tosca y sin grandes algoritmos, pero yo no ando dando dulces besos (WTF, jaja) (broma), a su respuesta por mi codigo, a mi me funciona, y para mi eso basta. 

PD:  comprueven la velocidad (Mi Basura de Codigo) le gana a MrFrog