excel vba 只保留字符串中的数字

Question

我有这段代码可以获取剪贴板上的任何内容并删除几个字符。
但是最近这些字符也变成了字母字符。
我遇到了删除数字的代码，但 我只想简单地保留~仅~数字，它的倒数。

我用谷歌搜索了很多，还是没弄清楚。

    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

我当前的代码是这样做的：

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

Answer 1

一个简单的方法是在函数中使用正则表达式。只需将字符串传递给此函数，它将删除所有 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

如果不想使用正则表达式，可以循环遍历字符串：

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

Answer 2

为了艺术的缘故，另一种方法是

Match() 识别数字数组中的元素编号 （参见 b 部分） 和
否定 Filter() 删除之前标记为 non-digits 参见 c 和 d)

没有展示更好或更快方法的野心。

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

帮助功能String2Arr()

在原子化字符串输入后分配单个字符数组：

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

Answer 3

回复后，我稍微修改了一下代码，然后就变成了这个。
此代码从剪贴板获取字符串，删除数字以外的所有内容并将字符串放回剪贴板。

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

excel vba 只保留字符串中的数字

excel vba keep only numbers in string

string

excel

vba

numbers