Option Explicit
'
Sub abc()
Dim a, i, j, s, m, t(1)
a = Range("a1:a" & Cells(Rows.Count, "a").End(xlUp).Row).Value
s = "01234567890来"
ReDim b(1 To UBound(a) * 10, 1 To 1) As String
For i = 1 To UBound(a)
For j = 1 To Len(a(i, 1))
t(0) = Mid(a(i, 1), j, 1)
If InStr(s, t(0)) = 0 Then t(0) = Space(1)
t(1) = t(1) & t(0)
Next
t(1) = t(1) & Space(1)
Next
t(1) = Split(t(1))
For i = 0 To UBound(t(1))
If Len(t(1)(i)) Then m = m + 1: b(m, 1) = t(1)(i)
Next
[c1].Resize(m) = b
End Sub
'
Sub abc()
Dim a, i, j, s, m, t(1)
a = Range("a1:a" & Cells(Rows.Count, "a").End(xlUp).Row).Value
s = "01234567890来"
ReDim b(1 To UBound(a) * 10, 1 To 1) As String
For i = 1 To UBound(a)
For j = 1 To Len(a(i, 1))
t(0) = Mid(a(i, 1), j, 1)
If InStr(s, t(0)) = 0 Then t(0) = Space(1)
t(1) = t(1) & t(0)
Next
t(1) = t(1) & Space(1)
Next
t(1) = Split(t(1))
For i = 0 To UBound(t(1))
If Len(t(1)(i)) Then m = m + 1: b(m, 1) = t(1)(i)
Next
[c1].Resize(m) = b
End Sub