如何在Excel中获取8位数字列表，并将每个数字分配给自己的行？

Question

假设我有一个Excel列表{12345, 12354, 12435, etc...}。我想输出一个列表，每个数字{1,2,3,4,5,1,2,3,5,4,1,2,4,3,5, etc...}都有一行。

对任何建议开放！

编辑（来自评论）
样本数据：

结果：

Answer 1

使用 A1 中的列表运行此宏：

Sub SplitApart()
    Dim K As Long, i As Long, L As Long
    Dim r As Range, vv As String, v As String
    Set r = Range("A1")
    v = r.Value
    L = Len(v)
    K = r.Row + 1

    For i = 1 To L
        vv = Mid(v, i, 1)
        If IsNumeric(vv) Then
            Cells(K, 1).Value = vv
            K = K + 1
        End If
    Next i
End Sub

生产：

代码将处理单个单元格中任意逗号分隔的数据

Answer 2

在我的回答中，您的原始数据位于A列中并且是数字。 然后，运行此宏后，您将在下一列（B）中得到结果。

Sub splitByDigits()
    Dim sourceColumnNumber as integer
    Dim destinationColNumber as integer
    sourceColumnNumber = 1         ' For reading from column A
    destinationColNumber = 2       ' For writing to column B

    Dim strValue As String
    Dim net As Integer, pow As Integer
    Dim resultRow As Long

    resultRow = 1

    For i = 1 To ActiveSheet.Rows.Count
        strValue = Trim(ActiveSheet.Cells(i, sourceColumnNumber).Value & " ")
        If (strValue = "") Then Exit For

        net = Val(strValue)
        pow = Len(strValue) - 1

        While (net > 0)
            ActiveSheet.Cells(resultRow, destinationColNumber).Value = Fix(net \ 10 ^ pow)
            resultRow = resultRow + 1
            net = net Mod 10 ^ pow
            pow = pow - 1
        Wend
    Next i
End Sub

而且......

Answer 3

Sub SplitDigits()
    Dim rngLastCell As Range, tmpCell As Range
    Dim x As Integer, rngTarget As Range

    Set rngLastCell = Range("A1").Offset(Rows.Count - 1).End(xlUp)
    Set rngTarget = Range("B1")

    For Each tmpCell In Range("A1", rngLastCell.Address)
        For x = 1 To Len(tmpCell.Value)
            rngTarget = Mid(tmpCell.Value, x, 1)
            Set rngTarget = rngTarget.Offset(1)
        Next x
    Next tmpCell
End Sub