用于将数字提取到多个单元格的VBA代码

Sub ExtractNumbers()
    Dim sourceRange As Range
    Dim targetRange As Range
    Dim cell As Range
    Dim value As Variant
    
    ' 设置源数据范围
    Set sourceRange = Range("A1:A10")
    
    ' 设置目标数据范围
    Set targetRange = Range("B1:B10")
    
    ' 遍历源数据范围
    For Each cell In sourceRange
        ' 提取数字
        value = ExtractNumber(cell.Value)
        
        ' 将提取的数字写入目标数据范围
        targetRange.Value = value
        
        ' 移动目标数据范围到下一行
        Set targetRange = targetRange.Offset(1, 0)
    Next cell
End Sub

Function ExtractNumber(text As String) As Variant
    Dim regex As Object
    Dim matches As Object
    Dim match As Object
    Dim result As String
    
    ' 创建正则表达式对象
    Set regex = CreateObject("VBScript.RegExp")
    
    ' 设置正则表达式模式，匹配数字
    regex.Pattern = "\d+"
    
    ' 执行正则表达式匹配
    Set matches = regex.Execute(text)
    
    ' 遍历匹配结果
    For Each match In matches
        ' 将匹配的数字拼接成字符串
        result = result & match.Value & ","
    Next match
    
    ' 去除最后一个逗号
    If Len(result) > 0 Then
        result = Left(result, Len(result) - 1)
    End If
    
    ' 返回提取的数字
    ExtractNumber = result
End Function