用VBA提取字符串中的数字

标签：取字符串   开始   位置   cell   实现   pytho   ring   tar   第一个   

上一篇讲了用 python 提取字符串中的数字，这次用VBA来实现。总体思路和 python 是一样的，代码如下：

Option Explicit

Sub GetNumbers()
    
    Dim from_string As String, convert_numbers As String
    Dim i, j, k, m, first_number_location
    Dim i1 As String
    Dim check_start(9) As String, check_end(10) As String
    Dim split_string() As String, get_numbers() As String
    
    ‘ 给 from_string 赋值
    from_string = Cells(1, 1)
    from_string = CStr(from_string)
    
    ‘ 先求出 check_start 和 check_end
    ‘ 用于后续检验 from_string 中每个字符是否是数字
    For i = 0 To 9
        i1 = CStr(i)
        check_start(i) = i1
        check_end(i) = i1
    Next i
    
    check_end(10) = "."
    
    ‘ 将 from_string 拆分，每个字符都存到 split_string 中
    ReDim split_string(Len(from_string) - 1)
    For i = 1 To Len(from_string)
        split_string(i - 1) = Mid(from_string, i, 1)
    Next i
    
    
    ‘ 先求出 split_string 中第一个数字及其位置
    For i = LBound(split_string()) To UBound(split_string())
        For j = LBound(check_start()) To UBound(check_start())
            If split_string(i) = check_start(j) Then
                ReDim get_numbers(UBound(split_string) - i)
                get_numbers(0) = split_string(i)
                first_number_location = i
                GoTo GetFirstNumberAlready
            End If
        Next j
    Next i
    
GetFirstNumberAlready:
    m = 1
    
    ‘ 从第一个数字开始，求出之后紧连的每个数字，包括小数点
    For j = first_number_location + 1 To UBound(split_string())
        For k = LBound(check_end()) To UBound(check_end())
            If split_string(j) = check_end(k) Then
                get_numbers(m) = split_string(j)
                m = m + 1
            End If
        Next k
    Next j
    
    ‘ 把 get_numbers() 输出
    For j = LBound(get_numbers()) To UBound(get_numbers())
        convert_numbers = convert_numbers & get_numbers(j)
    Next j
    
    MsgBox convert_numbers
    
End Sub

用VBA提取字符串中的数字

标签：取字符串   开始   位置   cell   实现   pytho   ring   tar   第一个   

原文地址：https://www.cnblogs.com/fliegendetuan/p/14704746.html