使用VBA从字符串中提取连续数字

I've written a sub that extracts all the digits from a string in cell A1 and pastes the result in cell A2. This loops through each row repeating the process until all cells containing strings have been worked through.

我写了一个sub，它从单元格A1中的字符串中提取所有数字，并将结果粘贴到单元格A2中。这循环遍历重复该过程的每一行，直到包含字符串的所有单元格都已完成。

However, I would like to only extract the numbers that are consecutive (more than 1 digit)

但是，我想只提取连续的数字（超过1位数）

for example: from this string: string-pattern-7---62378250-stringpattern.html I only want to extract the digits 62378250 and not the preceding 7.

例如：从这个字符串：string-pattern-7 --- 62378250-stringpattern.html我只想提取数字62378250而不是前面的7。

How should I alter my code to achieve this?

我应该如何改变我的代码来实现这一目标？

Option Explicit

Function onlyDigits(s As String) As String
    ' Variables needed (remember to use "option explicit").   '
    Dim retval As String    ' This is the return string.      '
    Dim i As Integer        ' Counter for character position. '

    ' Initialise return string to empty                       '
    retval = ""

    ' For every character in input string, copy digits to     '
    '   return string.                                        '
    For i = 1 To Len(s)
        If Mid(s, i, 1) >= "0" And Mid(s, i, 1) <= "9" Then
            retval = retval + Mid(s, i, 1)
        End If
    Next

    ' Then return the return string.                          '
    onlyDigits = retval
End Function


Sub extractDigits()

Dim myStr As String

Do While ActiveCell.Value <> Empty
        myStr = onlyDigits(ActiveCell.Value)
        ActiveCell(1, 2).Value = myStr
        ActiveCell.Offset(1, 0).Select
    Loop

End Sub

3 个解决方案

#1

Think this should do it if you only have one sequence

如果您只有一个序列，请认为这应该这样做

Function onlyDigits(v As Variant) As String

With CreateObject("vbscript.regexp")
    .Pattern = "\d{2,}"
    If .Test(v) Then onlyDigits = .Execute(v)(0)
End With

End Function

#2

Consider:

考虑：

Public Function onlyDigits(s As String) As String
    Dim L As Long, s2 As String, i As Long, Kapture As Boolean
    Dim CH As String, temp As String

    s2 = s & " "
    L = Len(s2)
    Kapture = False
    temp = ""
    onlyDigits = ""

    For i = 1 To L
        CH = Mid(s2, i, 1)
        If IsNumeric(CH) Then
            temp = temp & CH
            If Len(temp) > 1 Then Kapture = True
        Else
            If Len(temp) < 2 Then
                temp = ""
            Else
                If Kapture Then
                    Exit For
                End If
            End If
        End If
    Next i

    If Kapture Then onlyDigits = temp
End Function

#3

This is fairly similar to the excellent answer of @Gary'sStudent but has a slightly different structure:

这与@ Gary'sStudent的优秀答案非常相似，但结构略有不同：

Function ConsecutiveDigits(s As String) As String
    'returns the first substring consisting of 2 or more
    'consecutive digits which is delimited by either a
    'nondigit or the edge of the string
    'returns empty string if no such subtring exists

    Dim i As Long
    Dim c As String
    Dim digits As String

    For i = 1 To Len(s)
        c = Mid(s, i, 1)
        If IsNumeric(c) Then
            digits = digits & c
        Else
            If Len(digits) > 1 Then
                ConsecutiveDigits = digits
                Exit Function
            Else
                digits = "" 'reset
            End If
        End If
    Next i
    'we are at the end of the string -- should we return digits?
    If Len(digits) > 1 Then ConsecutiveDigits = digits
    'else return default empty string

End Function

#1