将第2列和第3列数据分隔为新行 [英] Split delimited 2nd and 3rd column data into new rows

问题描述

我有以下表格

  ID.      ID2.              String
  123.     567, 986          ABC;BCD;ACD
  142.     134, 654,1134     AA;BB

我想要显示

 ID   ID2  String
 123  567  ABC
 123  986  BCD
 123       ACD
 142  134  AA
 142  654  bb
 142  1134

ID 列中的值是唯一的。

The values in the ID column are unique.

有没有一个有效的宏解决方案？我有一个非常大的数据集。

Is there an efficient macro solution to this? I have a very huge set of data.

推荐答案

只有活动工作表中的起始连接数据和 ID 在A1中运行此宏。

With only the starting, concatenated data in the active sheet and ID is in A1, run this macro.

Sub split_out()
    Dim v As Long, vVALs As Variant, vID2s As Variant, vSTRs As Variant
    Dim rw As Long, lr As Long, mx As Long

    With ActiveSheet
        lr = .Cells(Rows.Count, 1).End(xlUp).Row
        .Cells(1, 1).CurrentRegion.Rows(1).Copy Destination:=.Cells(lr + 2, 1)
        For rw = 2 To lr
            vVALs = Application.Index(.Cells(rw, 1).Resize(1, 3).Value, 1, 0)
            vID2s = Split(vVALs(2), Chr(44))
            vSTRs = Split(vVALs(3), Chr(59))
            mx = Application.Max(UBound(vID2s), UBound(vSTRs))
            For v = LBound(vID2s) To mx
                .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = vVALs(1)
                If UBound(vID2s) >= v Then _
                    .Cells(Rows.Count, 1).End(xlUp).Offset(0, 1) = vID2s(v)
                If UBound(vSTRs) >= v Then _
                    .Cells(Rows.Count, 1).End(xlUp).Offset(0, 2) = vSTRs(v)
            Next v
        Next rw
    End With

End Sub

平铺的数据将填充在现有数据的下方。您的结果应该类似于以下内容。

The flattened data will be populated below the existing data. Your results should be similar to the following.

这篇关于将第2列和第3列数据分隔为新行的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！