将第2和第3列分隔数据拆分为新行

Question

我有下表

  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列中的值是唯一的。

这是否有效的宏观解决方案？我有一套非常庞大的数据。

Answer 1

试试这个。

Sub FlattenData()
    Dim rng As Range, arr() As Variant, i As Long, rw As Long, j As Long

    Set rng = Range("A1:C2") //Update for your range
    arr() = rng

    rng.ClearContents

            rw = 0

    For i = 1 To UBound(arr, 1)
        colBTemp = VBA.Split(arr(i, 2), ",")
        colCTemp = VBA.Split(arr(i, 3), ";")

        colBTempLength = UBound(colBTemp, 1) + 1
        colCTempLength = UBound(colCTemp, 1) + 1
        requiredRows = WorksheetFunction.Max(colBTempLength, colCTempLength)

        For j = 1 To requiredRows
            Range("A" & rw + j) = arr(i, 1)

            If j <= colBTempLength Then
                Range("B" & rw + j) = colBTemp(j - 1)
            Else
                Range("B" & rw + j) = vbNullString
            End If

            If j <= colCTempLength Then
                Range("C" & rw + j) = colCTemp(j - 1)
            Else
                Range("C" & rw + j) = vbNullString
            End If
        Next j

        rw = rw + requiredRows
    Next i
End Sub

Answer 2

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

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

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