在Excel中将一行分割成多行

我有一个Excel工作表，如下所示：

Drink Apple Juice, Orange Juice, Coffee Cup Ceramic Cup, Paper Cup, Plastic Cup, Stainless Steel Cup 

我想分割和整理单元格值：

 Drink Apple Juice Drink Orange Juice Drink Coffee Cup Ceramic Cup Cup Paper Cup Cup Plastic Cup Cup Stainless Steel Cup 

非常感谢。

EDITTED

Answer 1

你也可以试试这个：

 'for getting used range in rows Function rngused(RowNo As Long) As Range Dim rngg As Range, lastcol As Range Set rngg = ActiveSheet.Rows(RowNo) Set lastcol = rngg.Find(What:="*", After:=Cells(RowNo, 1), SearchDirection:=xlPrevious) Set rngused = Range(Cells(RowNo, 1), Cells(RowNo, lastcol.Column)) Set rngg = Nothing: Set lastcol = Nothing End Function 'for splitting and merging Sub SplitCol2Row(rngPassed As Range, offcet As Long) Dim i As Long, rngMerged As Range For i = 2 To rngPassed.Columns.Count Set rngMerged = Application.Union(rngPassed(1), rngPassed(i)) rngMerged.Copy Range("A" & i - 1).Offset(offcet, 0).PasteSpecial xlPasteAll Next Set rngMerged = Nothing End Sub 'main procedure Sub Main() Application.ScreenUpdating = False Dim rngRow As Range, lastrow As Range, ii As Long For ii = 2 To 4 'these are source rows Set rngRow = rngused(ii) Set lastrow = Range("A:A").Find(What:="*", After:=[A1], SearchDirection:=xlPrevious) SplitCol2Row rngRow, lastrow.Row Application.CutCopyMode = False Set rngRow = Nothing: Set lastrow = Nothing Next Application.ScreenUpdating = False End Sub 

Answer 2

这个macros应该做得很好：

 Sub SplitCellsAndExtend_New() 'takes cells with inside line feeds and creates new row for each. 'reverses merge into top cell. 'turn off updates to speed up code execution With Application .ScreenUpdating = False .EnableEvents = False .Calculation = xlCalculationManual End With Dim strCell As String, lastRow As Long, lRowLoop As Long, j As Long, arSplit Application.ScreenUpdating = False Const lColSplit As Long = 2 'update column number for the column that must be split Const sFirstCell As String = "A1" Dim sSplitOn As String sSplitOn = "," 'separating character lastRow = Cells(Rows.Count, lColSplit).End(xlUp).Row For lRowLoop = lastRow To 1 Step -1 arSplit = Split(Cells(lRowLoop, lColSplit), sSplitOn) If UBound(arSplit) > 0 Then Rows(lRowLoop + 1).Resize(UBound(arSplit) + 1).Insert Cells(lRowLoop, lColSplit).Resize(, UBound(arSplit) + 1).Value = arSplit Cells(lRowLoop, lColSplit).Resize(, UBound(arSplit) + 1).Copy Cells(lRowLoop + 1, lColSplit).PasteSpecial Transpose:=True Cells(lRowLoop, 1).Resize(, lColSplit - 1).Copy Cells(lRowLoop + 1, 1).Resize(UBound(arSplit) + 1) Rows(lRowLoop).Delete End If Set arSplit = Nothing Next With Application .ScreenUpdating = True .EnableEvents = True .Calculation = xlCalculationAutomatic End With End Sub