Excel宏 - 逗号分隔单元格到行

这个宏将从A列获取数据并将其"提取"到B列.结果显示如下,随意畏缩我的图形演示技巧:-)

    <- A ->   <- B ->
1   a, b, c   a
2   d         b
3   e         c
4   f, g      d
5   h         e
6   i         f
7             g
8             h
9             i

我把它作为非破坏性的测试用途,因为创建一个新列相对容易,填充它并删除VBA中的旧列.为读者练习......

这是宏:

Option Explicit
Sub Macro1()
    Dim fromCol As String
    Dim toCol As String
    Dim fromRow As String
    Dim toRow As String
    Dim inVal As String
    Dim outVal As String
    Dim commaPos As Integer

    ' Copy from column A to column B.'
    fromCol = "A"
    toCol = "B"
    fromRow = "1"
    toRow = "1"

    ' Go until no more entries in column A.'
    inVal = Range(fromCol + fromRow).Value
    While inVal <> ""

        ' Go until all sub-entries used up.'
        While inVal <> ""
            Range(fromCol + fromRow).Select

            ' Extract each subentry.'
            commaPos = InStr(1, inVal, ",")
            While commaPos <> 0

                ' and write to output column.'
                outVal = Left(inVal, commaPos - 1)
                Range(toCol + toRow).Select
                Range(toCol + toRow).Value = outVal
                toRow = Mid(Str(Val(toRow) + 1), 2)

                ' Remove that sub-entry.'
                inVal = Mid(inVal, commaPos + 1)
                While Left(inVal, 1) = " "
                    inVal = Mid(inVal, 2)
                Wend
                commaPos = InStr(1, inVal, ",")
            Wend

            ' Get last sub-entry (or full entry if no commas).'
            Range(toCol + toRow).Select
            Range(toCol + toRow).Value = inVal
            toRow = Mid(Str(Val(toRow) + 1), 2)
            inVal = ""
        Wend

        ' Advance to next source row.'
        fromRow = Mid(Str(Val(fromRow) + 1), 2)
        Range(fromCol + fromRow).Select
        inVal = Range(fromCol + fromRow).Value
    Wend
End Sub