codigo para sacar de un conjunto de texto números

[Psyke1]

Si si, eso quedo claro, pero...
Entonces que quieres hacer si tienes la cadena: "6546.65163.565"?
No lo guardarias en el array??

Salu2!

[Karcrack]

He hecho esta bonita funcion mientras me aburria

Código (vb) [Seleccionar] Expandir

Public Function ExtractNumbers(ByVal sString As String, Optional bReturnAsString As Boolean = False) As Collection
   Dim cTemp   As New Collection
   Dim sTemp   As String
   Dim sChar   As String * 1
   Dim i       As Long
   
   sString = Replace$(sString, ",", ".")
   
   For i = 1 To Len(sString)
       sChar = Mid$(sString, i, 1)
       Do While (sChar Like "#") Or (sChar = ".")
           sTemp = sTemp & sChar
           i = i + 1
           sChar = Mid$(sString, i, 1)
       Loop
       If Val(sTemp) Then
           cTemp.Add IIf((bReturnAsString = False), Val(sTemp), sTemp)
       End If
       sTemp = vbNullString
   Next i
   
   Set ExtractNumbers = cTemp
End Function

Ejemplo:

Código [Seleccionar] Expandir

Private Sub Form_Load()
   Dim vItem   As Variant
   
   For Each vItem In ExtractNumbers("Estoy provando la extracción de números como 1992, también la extracción de números decimales: 3,1415 o 3.1415")
       Debug.Print vItem
   Next vItem
End Sub

[raul338]

Código (vb) [Seleccionar] Expandir



Public Function GetNumeros(text As String) As Collection
    ' Incluir en las referencias: Microsoft VBScritp Regular Expressions 5.5
    ' Obtener numeros, mediante expresiones regulares. By Raul338
    On Error GoTo err
    Dim cTemp As New Collection
    Dim objRegExp As RegExp
    Dim objMatch As Match
    Dim objMatches
   
    Set objRegExp = New RegExp
    Dim patron As String
   
    'patron = "(\d+)"                            ' Numeros enteros
    'patron = "(\d+(?:[\.,]\d+)?)"                ' Numeros con/sin decimales
    patron = "(\d{1,3}(\.\d{3})+(?:,\d+)?|\d+(?:,\d+)?)"   ' Numeros con separador de miles (.) con/sin decimales (,)
    'patron = "(\d{1,3}(\,\d{3})+(?:\.\d+)?|\d+(?:\.\d+)?)"   ' Numeros con separador de miles (,) con/sin decimales (.)
    'patron = "(\d+[,.]\d+)"                        ' Numeros con decimales
   
    objRegExp.Pattern = patron
    objRegExp.Global = True
   
    Set objMatches = objRegExp.Execute(text)
   
    For Each objMatch In objMatches
        cTemp.Add objMatch.Value
     Next
    Set GetNumeros = cTemp
    Exit Function
err:
    ' Aca tira error en caso de que metan mal la mano en las expresiones regulares xD
End Function


Código (vb) [Seleccionar] Expandir


Private Sub Form_Load()
    Dim item As Variant
    Dim s As String
    s = "Estoy provando la extracción de números como 1992, también la extracción de números decimales: 3,1415"
    s = s & "Tambien puedo decir que tengo 1000000,24 dolares o 1.123.456,78 euros (?)"
    For Each item In GetNumeros(s)
        Debug.Print item
    Next
End Sub


Aver quien supera eso (?)

[BlackZeroX]

... la cosa era usar un algoritmo ¬¬" no Expresiones R. tramposo ¬¬". jajaja.

bueno para evitar la referencia usar

Código (Vb) [Seleccionar] Expandir



    Dim cTemp       As New Collection
    Dim objRegExp   As Object 'RegExp
    Dim objMatch    As Object 'Match
    Dim objMatches  As Object
    Dim patron      As String
   
    Set objRegExp = CreateObject("VBScript.RegExp") 'New RegExp



Dulce Infierno Lunar!¡.

[Psyke1]

@Karcrack

Me aburria

He hecho esta bonita funcion mientras me aburria

AJAJAJA
Te aburres mucho tu, ¿¿eh??  

... la cosa era usar un algoritmo ¬¬" no Expresiones R. tramposo ¬¬". jajaja.

JAJAJJAJA
Raul y sus Expr.Reg...

Bueno aqui os dejo la funcion que prometi, que ademas capta los numeros negativos :

Código (vb) [Seleccionar] Expandir


Option Explicit

Public Function Get_Only_Numbers(ByVal sText As String) As String()
   Const sDecimals             As String = ",.'"
   Dim sNumbersArray()         As String
   Dim sActualChar             As String * 1
   Dim sNextChar               As String * 1
   Dim sPreviousChar           As String * 1
   Dim bAcceptString           As Boolean
   Dim lTotalChar              As Long
   Dim x                       As Long
   Dim y                       As Long

   lTotalChar = Len(sText)
   If lTotalChar > 0 Then
       ReDim sNumbersArray(0)
       For x = 1 To lTotalChar
           If x > 1 Then sPreviousChar = Mid$(sText, x - 1, 1)
           sActualChar = Mid$(sText, x, 1): sNextChar = Mid$(sText, x + 1, 1)
           If ((sActualChar = Chr$(45) Or InStr(sDecimals, sActualChar) > 0 And IsNumeric(sPreviousChar)) _
           And IsNumeric(sNextChar)) Or (IsNumeric(sActualChar)) Then
               bAcceptString = True
           Else
               If bAcceptString = True Then y = y + 1: ReDim Preserve sNumbersArray(y): bAcceptString = False
           End If
           If bAcceptString = True Then sNumbersArray(y) = sNumbersArray(y) & sActualChar
       Next x
       Get_Only_Numbers = sNumbersArray()
       Erase sNumbersArray
   End If
End Function

Private Sub Form_Load()
   Dim vItem                 As Variant
   Dim sStringToAnalyze      As String

   sStringToAnalyze = "Estoy provando la extracción de números como 1992, también la extracción de números decimales: 3,1415 o 3.1415"
   sStringToAnalyze = sStringToAnalyze & "También puedo decir que tengo 1000000,24 dólares o 1.123.456,78 euros (?)"
   sStringToAnalyze = sStringToAnalyze & "Pero mi función también reconoce numeros como el -2344 y 5'567 y no los confunde con m.456 ni con -a89 ... =)"
   For Each vItem In Get_Only_Numbers(sStringToAnalyze): Debug.Print vItem: Next
End Sub

Obtengo esto:

3,1415
3.1415
1000000,24
1.123.456,78
-2344
5'567
456
89

Salu2!

[raul338]

... la cosa era usar un algoritmo ¬¬" no Expresiones R. tramposo ¬¬". jajaja.

Yo dije primero que se puede con expreg. Ustedes fueron los tipos con tiempo libre para dedicarle al tema, yo la hice facil y corta xD

He hecho esta bonita funcion mientras me aburria

No funciona con los ultimos 2 numeros q puse

[Psyke1]

... la cosa era usar un algoritmo ¬¬" no Expresiones R. tramposo ¬¬". jajaja.

Yo dije primero que se puede con expreg. Ustedes fueron los tipos con tiempo libre para dedicarle al tema, yo la hice facil y corta xD

He hecho esta bonita funcion mientras me aburria

No funciona con los ultimos 2 numeros q puse

JOJOJOJO
No, si al final acabamos a tortas!!

Salu2!

[Karcrack]

Buen codigo Psyke, pero seria mas sencillo si trabajaras con Collections

[Psyke1]

Gracias Karcrack!
Lo tendre en cuenta para futuras ocasiones!

Salu2!

[Psyke1]

Buff, espero que no me llameis pesado  , pero esta es mi RegExp para hacer EXACTAMENTE lo que hace la funcion que postee:

((\-)?\d+(([\.,']\d+)+)?)

Claro que no incluye validacion como la que hizo Raul...  
Predon por revivir post...

DoEvents¡!