Split delimited 2nd and 3rd column data into new rows

后端 未结 2 1913
盖世英雄少女心
盖世英雄少女心 2021-01-27 14:46

I have the following table

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

I wa

相关标签:
2条回答
  • 2021-01-27 15:20

    Try this.

    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
    
    0 讨论(0)
  • 2021-01-27 15:24

    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.

            Flatten data with arrays

    0 讨论(0)
提交回复
热议问题