Excel VBA: 提取最后一连串数字 // Comee

提取最后一连串数字，采用从后往前查找的方式，程序中限定了返回结果字符串的长度必须为 15 或 16 或者 17 。

Sub ExtractTheLastSuccessiveNumbers()
'Update by 20150702
Dim Rng As Range
Dim WorkRng As Range
Dim xValue As String
Dim OutValue As String
Dim PreviousIsNumber As Boolean
Dim Find As Boolean
Dim index As Integer

On Error Resume Next
xTitleId = "QQ的小工具箱[逆序读取]"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("选择数据范围", xTitleId, WorkRng.Address, Type:=8)

For Each Rng In WorkRng
    OutValue = ""
    PreviousIsNumber = False
    Find = False
    xValue = Rng.Value
    index = VBA.Len(xValue) + 1
    
    For i = 1 To VBA.Len(xValue)

        If VBA.IsNumeric(VBA.Mid(xValue, index - i, 1)) Then
                
            Find = True
            
            If PreviousIsNumber Then
                OutValue = VBA.Mid(xValue, index - i, 1) & OutValue
            Else
                OutValue = VBA.Mid(xValue, index - i, 1)
            End If
            PreviousIsNumber = True
            
        Else
            PreviousIsNumber = False
            
            If Find Then
                Exit For
            End If
            
        End If
    Next
    
    Rng.NumberFormat = "@"
    'Rng.NumberFormat = "0"
    If VBA.Len(OutValue) = 15 Or VBA.Len(OutValue) = 16 Or VBA.Len(OutValue) = 17 Then
        Rng.Value = OutValue
    Else
        Rng.Value = ""
    End If
Next

End Sub