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

B Z*_*B Z 5 excel vba excel-vba

我在excel中有以下数据:

a, b, c
d
e
f, g
h
i
Run Code Online (Sandbox Code Playgroud)

每行代表一行和一个单元格.

我想将其转换为:

a
b
c
d
e
f
g
h
i
Run Code Online (Sandbox Code Playgroud)

我正在使用以下宏,但我不能让自动调整大小来执行插入,而不是覆盖单元格值.任何帮助表示赞赏.

    Sub SplitCells()


    Dim i As Long



    With Application

        .Calculation = xlCalculationManual

        .ScreenUpdating = False




    For i = 1 To Selection.Rows.Count

        Dim splitValues As Variant


        splitValues = split(Selection.Rows(i).Value, ",")

        Selection.Rows(i).Resize(UBound(splitValues) - LBound(splitValues) + 1).Value = Application.Transpose(splitValues)

    Next i



        .Calculation = xlCalculationAutomatic

        .ScreenUpdating = True

    End With

End Sub
Run Code Online (Sandbox Code Playgroud)

pax*_*blo 6

这个宏将从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
Run Code Online (Sandbox Code Playgroud)

我把它作为非破坏性的测试用途,因为创建一个新列相对容易,填充它并删除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
Run Code Online (Sandbox Code Playgroud)