excel vba keep only numbers in string-CodePudding

I have this code that gets whatever is on the clipboard and removes several characters.
But recenty these characters also became alphacaracters too.
I came across this code that REMOVES the numbers but I want to is just simply keep ~only~ the numbers, its inverse.

I did a lot of googleing and could not figure it out.

    Dim x
    Dim tmp As String
    tmp = input1
    'remove numbers from 0 to 9 from input string
    For x = 0 To 9
        tmp = Replace(tmp, x, "")
    Next
    'return the result string
    removenumbers = tmp

My current code does this:

Sub y_chave_danfe()

    On Error GoTo ER2

    Dim atransf As New MSForms.DataObject
    Dim chave As Variant
    Dim danfe As Variant

    atransf.GetFromClipboard
    chave = atransf.GetText
    danfe = Replace(Replace(Replace(Replace(Replace(chave, " ", ""), "/", ""), "-", ""), ".", ""), "_", "")
    CreateObject("htmlfile").parentWindow.clipboardData.setData "text", danfe

Exit Sub

ER2:
End Sub

CodePudding user response：

A simple method is by using Regular Expressions in a function. Merely pass the string to this function, at it will remove all of the non-digits:

Function removeNonDigits(str As String) As String 'or as long, if you prefer
    Dim re As Object
    
Set re = CreateObject("vbscript.regexp")
With re
    .Pattern = "\D "
    .Global = True
    removeNonDigits = .Replace(str, "")
End With
End Function

If you don't want to use Regular Expressions, you can loop through the string:

Function removeNonDigits(str As String) As String
    Dim I As Long
    Dim tmp As String

tmp = ""
For I = 1 To Len(str)
    If IsNumeric(Mid(str, I, 1)) Then
        tmp = tmp & Mid(str, I, 1)
    End If
Next I

removeNonDigits = tmp
End Function

CodePudding user response：

Just for the sake of the art an alternative approach via

Match() identifying the element number in a digits array (see section b) and
negative Filter() deleting previously marked non-digits see section c and d)

without the ambition to show a better or faster way.

Function OnlyDigits(ByVal s As String)
'a) define array of all digits
    Dim digits: digits = String2Arr("1234567890")
'b) get any digit position within digits array     ' note: zero position returns 10
    Dim tmp: tmp = Application.Match(String2Arr(s), digits, 0)
'c) check for digits in a loop through tmp
    Dim i As Long
    For i = 1 To UBound(tmp)
        If IsNumeric(tmp(i)) Then                   ' found digit element
            tmp(i) = tmp(i) Mod 10                  ' include zero (10th element)
        Else                                        ' not found (Error 2042)
            tmp(i) = "DEL"                          ' mark non-digits for deletion
        End If
    Next i
'd) return digits
    OnlyDigits = Join(Filter(tmp, "DEL", False), "") ' delete marked elements
End Function

Help function String2Arr()

Assigns an array of single characters after atomizing a string input:

Function String2Arr(ByVal s As String)
    s = StrConv(s, vbUnicode)
    String2Arr = Split(s, vbNullChar, Len(s) \ 2)
End Function

CodePudding user response：

After the responses, I changed a little but both codes and came to this.
This code gets the string from the clipboard, remove everything besides the numbers and puts the string back to the clipboard.

Sub y_chave_danfe()

    On Error GoTo ER2

    Dim atransf As New MSForms.DataObject
    Dim chave As Variant
    Dim danfe As Variant
    Dim numerico As String
    Dim z As Long

    numerico = ""
    atransf.GetFromClipboard
    chave = atransf.GetText
    For z = 1 To Len(chave)
        If IsNumeric(Mid(chave, z, 1)) Then
            numerico = numerico & Mid(chave, z, 1)
        End If
    Next z
    danfe = numerico
    CreateObject("htmlfile").parentWindow.clipboardData.setData "text", danfe

Exit Sub

ER2:
End Sub