拆分分隔的第二和第三列数据到新行

Question

我有如下表

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

我希望它在ID栏中显示

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

的值是唯一的。

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

Answer 1

在只有起始，在有源板和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 

展平数据将填充到现有数据的下方。你的结果应该类似于以下内容。

Answer 2

试试这个。

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