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

Excel Macro - Comma Separated Cells to Rows

提问by B Z

I have have the following data in excel:

我在excel中有以下数据：

a, b, c
d
e
f, g
h
i

with each row, representing a row and in one cell.

每一行，代表一行和一个单元格。

I would like to convert it to:

我想将其转换为：

a
b
c
d
e
f
g
h
i

I am using the following macro, but I can't get the autosize to do an insert, instead of overriding the cell values. Any help is appreciated.

我正在使用以下宏，但我无法使用自动调整大小进行插入，而不是覆盖单元格值。任何帮助表示赞赏。

    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

回答by paxdiablo

This macro will take your data from column A and "extract" it to column B. The results are shown below, feel free to cower at my graphical presentation skills :-)

这个宏将从 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

I've left it as non-destructive for testing purposes, and since it's relatively easy to create a new column, populate it and delete the old column in VBA. An exercise for the reader...

为了测试目的，我将其保留为非破坏性，并且由于创建新列相对容易，因此在 VBA 中填充它并删除旧列。读者练习...

Here is the macro:

这是宏：

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

回答by dkretz

This is untested, but it's an algorithmic pattern I've used many times. It's been a while though, so don't trust the syntax exactly.

这是未经测试的，但它是我多次使用的算法模式。不过已经有一段时间了，所以不要完全相信语法。

sub SplitCells()  
    Dim c as Range      ' iterator for cells in Selection  
    dim r as Range      ' to hold the range which is the first cell in Selection  
    Dim r2 as Range     ' variable range for single cell which is the target for inserting the result  
    Dim a() a Variant   ' array of variants to hold each cell's value after it's split  
    Dim b() as Variant  ' array of variants to hold the accumulation of values to spread into the destination  
    Dim v ar Variant    ' variant to iterate through b for insertion  
    Dim i as Integer    ' cumulative offset from top of destination range while inserting  

    For each c in Selection.Cells  
        a = Split(Replace(c.Text, ",", "")) ' will split on whitespace  
        for each v in a  
            b.Add v  
        next v  
    next c  

    ' now you have a new array with the full set of values  

    ' insert them a row at a time using Range.Offset  
    i = 0  
    Set r = Selection.Cells(0)  
    For Each v in b  
        Set r2 = r.Offset(1, 0)  
        r2.Value = v  
        i = i + 1  
    next v  
End Sub  

回答by abhijit

I'm not very good at Excel VBA, but this worked (somehow!!)

我不太擅长 Excel VBA，但这有效（不知何故！！）

Sub arrange()

' get the current range from the sheet
    curr_range = ActiveSheet.Range("A1:A6")

' for each cell in that range ...
    For Each Row In curr_range

' ...put the contents into an array
        arr = Split(Row, ",")

' for each cell in that array ...
        For Each cell In arr

' ...output it into a string
            output_str = output_str & "," & cell
        Next cell

    Next Row

' remove spaces
    output_str = Replace(output_str, " ", "")
' remove left ,
    output_str = Right(output_str, Len(output_str) - 1)

' make it into an array
    output_arr = Split(output_str, ",")

' populate the sheet back
    ActiveSheet.Range("A:A").Value = Application.WorksheetFunction.Transpose(output_arr)

End Sub