How to Split a single cell into multiple rows and add another row

你离开我真会死。 提交于 2019-11-27 15:55:01

Loop through Column A then loop through the string next to it.

Results will be in column D

    Sub ChickatAH()
    Dim rng As Range, Lstrw As Long, c As Range
    Dim SpltRng As Range
    Dim i As Integer
    Dim Orig As Variant
    Dim txt As String

    Lstrw = Cells(Rows.Count, "A").End(xlUp).Row
    Set rng = Range("A2:A" & Lstrw)

    For Each c In rng.Cells
        Set SpltRng = c.Offset(, 1)
        txt = SpltRng.Value
        Orig = Split(txt, " ")

        For i = 0 To UBound(Orig)
            Cells(Rows.Count, "D").End(xlUp).Offset(1) = c
            Cells(Rows.Count, "D").End(xlUp).Offset(, 1) = Orig(i)
        Next i

    Next c

End Sub

This will require a bit of copy and paste and also the use of WORD but here are a few steps that should help you out.

  1. Copy the cell in question.
  2. Open Word
  3. Paste Special (use the dropdown arrow below the paste icon)
  4. Select the option - Unformatted Unicode Text (as your paste special option)
  5. Select All
  6. Replace
  7. Find What: (type in the space) Replace With: ^p (creates a new line)
  8. Copy and paste results back into excel

A formula solution is close to your requirement.

Cell H1 is the delimiter. In this case a space.

Helper E1:=SUM(E1,LEN(B1)-LEN(SUBSTITUTE(B1,$H$1,"")))+1

You must fill the above formula one row more.

A8:=a1

Fill this formula to the right.

A9:=LOOKUP(ROW(1:1),$E:$E,A:A)

Fill this formula to the right and then down.

B9:=MID($H$1&LOOKUP(ROW(A1),E:E,B:B)&$H$1,FIND("艹",SUBSTITUTE($H$1&LOOKUP(ROW(A1),E:E,B:B)&$H$1,$H$1,"艹",ROW(A2)-LOOKUP(ROW(A1),E:E)))+1,FIND("艹",SUBSTITUTE($H$1&LOOKUP(ROW(A1),E:E,B:B)&$H$1,$H$1,"艹",ROW(A2)-LOOKUP(ROW(A1),E:E)+1))-FIND("艹",SUBSTITUTE($H$1&LOOKUP(ROW(A1),E:E,B:B)&$H$1,$H$1,"艹",ROW(A2)-LOOKUP(ROW(A1),E:E)))-1)

Fill down.

Bug:

Date/time will be converted to value and blank will be filled with 0. You can add &"" to the end of the formula of A9 and B9 to block the value 0, but numbers/date/time will be converted to text.

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!