Cijfers scheiden van tekst uit cel

[marknijenhuis]

Hallo,

Ik heb een bestand waarin in een cel tekst en cijfers staan (de cijfers zijn serienummers, de tekst is ballast)
Nu wil ik alleen de cijfers naar een andere cel overhalen.

Ik heb een stukje VBA gevonden wat uit een cel de cijfers haalt, en de tekst niet.
Echter de code doet dit maar voor maximaal 10 cijfers. De hoeveelheid letters heeft geen invloed.

Hoe krijg ik de code zo dat ik alle cijfers uit de cel krijg?

Function TOONNUMMERS(A1 As Range)[ATTACH]327777.vB[/ATTACH]
Dim i As Integer
Dim Result As Long
For i = 1 To Len(A1)
If IsNumeric(Mid(A1, i, 1)) Then
Result = Result & Mid(A1, i, 1)
End If
Next i
TOONNUMMERS = Result
End Function

Als ik nu in een cel de functie TOONNUMMERS(A1) haalt die er 10 nummers uit.

Alvast dank voor de hulp.

 

[edmoor]

Maak er dit van:

Function TOONNUMMERS(B1 As Range) As Double
    Dim i As Integer
    Dim Res As String
    For i = 1 To Len(B1)
        If IsNumeric(Mid(B1, i, 1)) Then
            Res = Res & Mid(B1, i, 1)
        End If
    Next i
    TOONNUMMERS = CDbl(Res)
End Function

Of dit, afhankelijk van de bedoeling er mee:

Function TOONNUMMERS(B1 As Range) As String
    Dim i As Integer
    Dim Res As String
    For i = 1 To Len(B1)
        If IsNumeric(Mid(B1, i, 1)) Then
            Res = Res & Mid(B1, i, 1)
        End If
    Next i
    TOONNUMMERS = Res
End Function

 

[VenA]

Maak er een string van

Function TOONNUMMERS(B1 As Range) As String
  Dim i As Integer
  For i = 1 To Len(B1)
    If IsNumeric(Mid(B1, i, 1)) Then TOONNUMMERS = TOONNUMMERS & Mid(B1, i, 1)
  Next i
End Function

 

[marknijenhuis]

Heren dank, het werkt!

Nu hoef ik geen 12.000 regels met de hand af

Merci!

 

[HSV]

Zo hoef je niet elke cijfer/letter bij langs.

Function TOONNUMMERS(r As String) As String
    With CreateObject("VBScript.RegExp")
     .Global = True
     .Pattern = "[A-Za-z]"
      TOONNUMMERS = .Replace(r, "")
    End With
End Function