Tách dữ liệu từ nhiều đơn hàng thành các đơn hàng chi tiết

[bactu]

Em có một dữ liệu, khi xuất kho để sản xuất cho nhiều đơn hàng thì gộp chung tất cả các đơn hàng cần xuất cho 1 dòng dữ liệu tương ứng. Giờ em muốn tách thành các đơn hàng chi tiết tương ứng từng dòng như file đính kèm.
Trân trọng cảm ơn nhiều!!!

 

[giaiphap]

Em có một dữ liệu, khi xuất kho để sản xuất cho nhiều đơn hàng thì gộp chung tất cả các đơn hàng cần xuất cho 1 dòng dữ liệu tương ứng. Giờ em muốn tách thành các đơn hàng chi tiết tương ứng từng dòng như file đính kèm.
Trân trọng cảm ơn nhiều!!!

Dùng tạm thử code này xem sao.

Public Sub Order_Split()
Dim Arr(1 To 10000, 1 To 4), dArr, i As Integer, j As Integer, sArr
dArr = Sheet1.Range("A5:D" & Sheet1.Range("A65000").End(xlUp).Row).Value
For i = 1 To UBound(dArr)
    sArr = Split(dArr(i, 3), ";")
    For j = 0 To UBound(sArr)
        k = k + 1
        Arr(k, 1) = dArr(i, 1): Arr(k, 2) = dArr(i, 2)
        Arr(k, 3) = sArr(j): Arr(k, 4) = dArr(i, 4)
    Next j
Next i
Sheet1.Range("G5:J1000").ClearContents
If k Then Sheet1.Range("G5:J5").Resize(k) = Arr
End Sub

 

[snow25]

Em có một dữ liệu, khi xuất kho để sản xuất cho nhiều đơn hàng thì gộp chung tất cả các đơn hàng cần xuất cho 1 dòng dữ liệu tương ứng. Giờ em muốn tách thành các đơn hàng chi tiết tương ứng từng dòng như file đính kèm.
Trân trọng cảm ơn nhiều!!!

Đây bạn xem.

Sub tachdonhang()
   Dim arr, arr1
   Dim a As Long, b As Long, i As Long, j As Long, lr As Long, c As Long
   Dim T
   With Sheet1
      lr = .Range("B" & Rows.Count).End(xlUp).Row
      If lr < 5 Then MsgBox "khong co du lieu": Exit Sub
      arr = .Range("A5:D" & lr).Value
      ReDim arr1(1 To 10000, 1 To 4)
      For i = 1 To UBound(arr, 1)
          T = Split(";" & arr(i, 3), ";")
          b = UBound(T)
          For j = 1 To b
              a = a + 1
              arr1(a, 1) = arr(i, 1)
              arr1(a, 2) = arr(i, 2)
              arr1(a, 3) = T(j)
              arr1(a, 4) = arr(i, 4)
          Next j
     Next i
     c = .Range("G" & Rows.Count).End(xlUp).Row
     If c > 4 Then .Range("G5:j" & c).ClearContents
     .Range("G5").Resize(a, 4).Value = arr1
End With
End Sub

 

[bactu]

Quá tuyệt vời, em cảm ơn nhiều!!!