Sub 问题()
Dim reg, sols, arr, a, brr, b
Columns("A").NumberFormatLocal = "@"
Set reg = CreateObject("vbscript.regexp")
reg.Global = True
reg.Pattern = "(\d+)-(\d+)-(\d+)"
arr = [a1].CurrentRegion
For a = 2 To [a1].End(xlDown).row
Set sols = reg.Execute(arr(a, 1))
If sols.Count > 0 Then
ReDim brr(1 To sols(0).submatches.Count)
For b = 0 To UBound(brr, 1) - 1
brr(b + 1) = sols(0).submatches(b)
Next
Cells(a, 3).Resize(1, UBound(brr, 1)) = brr
Erase brr
End If
Next
Set reg = Nothing
Set sols = Nothing
End Sub