a1单元格的字符是：7-16 烟15元，67.6吃饭，礼品300元，超市46元。 以上消费记录有的带元，有为不带,并且带小数 7-16是日期不能提取。代码应依次提取到b1,c1,d1..... 请教老师指导，谢谢！

正则应该没问题。
提取第一个是数字，中间是连续的数字或者小数点还有-号
然后在进行一次判断，排除带-号的数字

Sub aa()
Dim Reg As Object
Dim Obj As Object
Dim I%, K%
Set Reg = CreateObject("VBScript.Regexp")
With Reg
.Global = True
.IgnoreCase = True
.MultiLine = True
.Pattern = "[^a-z]([0-9|/.|-]+)"
Set Obj = .Execute(Cells(1, 1).Value)
End With
K = 2
For I = 0 To Obj.Count - 1
If InStr(1, Obj.Item(I).SubMatches(0), "-") = False And Left(Obj.Item(I).SubMatches(0), 1) <> "." Then
Cells(K, 1) = Obj.Item(I).SubMatches(0)
K = K + 1
End If
Next
End Sub
输出排列和循环单元格 自己改改吧，核心功能在这里了

多谢老师，我补全了代码：
Sub 提取数字()
Dim reg As Object
Dim Obj As Object
Dim i As Integer
Dim lastRow As Integer
Dim currentCol As Integer
Set reg = CreateObject("VBScript.RegExp")
With reg
.Global = True
.IgnoreCase = True
.MultiLine = True
.Pattern = "[^a-z]([0-9|/.|-]+)" '
End With
lastRow = Cells(Rows.Count, 1).End(xlUp).Row ' 获取A列的最后一行
For i = 1 To lastRow
Set Obj = reg.Execute(Cells(i, 1).Value) ' 按行提取数字
currentCol = 2 ' 从B列开始输出结果
For Each Match In Obj
If InStr(1, Match.SubMatches(0), "-") = False And Left(Match.SubMatches(0), 1) <> "." Then
Cells(i, currentCol).Value = Match.SubMatches(0) ' 将数字写入当前列
currentCol = currentCol + 1 ' 切换到下一列
End If
Next Match
Next i
End Sub