将逗号分隔的条目拆分为新行,同时保留行数据

时间:2017-01-06 15:45:37

标签: excel vba excel-vba

我根本不知道vba,所以我想知道是否有人可以帮我解决我尝试创建的VBA代码。 我有很多数据。我在A到W列中有数据。

我有一个列,其中有多个数据用逗号分隔,如下所示:

Col V  |  Col W 
----   |  ----
1      |angry birds, gaming
2      |nirvana,rock,band

我想要做的是在第二列中拆分逗号分隔的条目并插入新的行,如下所示:

Col V|Col W
---- |----
1    |angry birds
1    |gaming
2    |nirvana
2    |rock
2    |band

基本上,我想要复制这个

Excel macro -Split comma separated entries to new rows

但我希望这样做,同时保持A-V列中的所有数据完好无损。另请注意,W列最多可包含40个需要分隔的项目。

非常感谢!

2 个答案:

答案 0 :(得分:1)

以这种方式试试。之前。

enter image description here

CODE

Option Explicit

Const ANALYSIS_ROW As String = "K"
Const DATA_START_ROW As Long = 2

Sub ReplicateData()
    Dim iRow As Long
    Dim lastrow As Long
    Dim ws As Worksheet
    Dim iSplit() As String
    Dim iIndex As Long
    Dim iSize As Long

    'Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    With ThisWorkbook
        .Worksheets("Sheet1").Copy After:=.Worksheets("Sheet1")
        Set ws = ActiveSheet
    End With

    With ws
        lastrow = .Cells(.Rows.Count, ANALYSIS_ROW).End(xlUp).Row
    End With


    For iRow = lastrow To DATA_START_ROW Step -1
        iSplit = Split(ws.Cells(iRow, ANALYSIS_ROW).Value2, ",")
        iSize = UBound(iSplit) - LBound(iSplit) + 1
        If iSize = 1 Then GoTo Continue

        ws.Rows(iRow).Copy
        ws.Rows(iRow).Resize(iSize - 1).Insert
        For iIndex = LBound(iSplit) To UBound(iSplit)
            ws.Cells(iRow, ANALYSIS_ROW).Offset(iIndex).Value2 = iSplit(iIndex)
        Next iIndex
Continue:
    Next iRow

    Application.CutCopyMode = False
    Application.Calculation = xlCalculationAutomatic
    'Application.ScreenUpdating = True
End Sub

enter image description here

答案 1 :(得分:-1)

根据您的数据(并且递增ID而不是交易破坏者,只是做出假设)您可以使用公式为您分解。这将实现以下目标,其中绿色区域是数据,黄色将形成所需的输出,并且为了便于理解,我添加了蓝色"帮助"列。 enter image description here 公式如下

C2填写=LEN(B2)-LEN(SUBSTITUTE(B2,",",""))+1

D2填写=SUM($C$2:C2)

F2 =A2

F3 =IF(ROW()-1>VLOOKUP($F2,$A$2:$D$4,4,0),$F2+1,$F2)已填写

G2 =COUNTIF($F$2:F2,F2)已填写

H2 =VLOOKUP($F2,$A$2:$B$4,2,0)已填写

I2 =IF($G2=1,SUBSTITUTE($H2,",",">",1),SUBSTITUTE(SUBSTITUTE(H2,",","<",G2-1),",",">",G2-1))已填写

J2 =IF($G2=1,1,FIND("<",$I2))填写

K2 =IF($G2<VLOOKUP($F2,$A$2:$D$4,3,0),FIND(">",$I2),LEN(H2)+1)-J2填写完毕 L2 =IF(ISERROR(H2),"--",MID(H2,J2,IF(K2>0,K2,1)))已填写

逗号计数,应该读段数,道歉。