Dùng VBA xử lý dữ liệu từ 1 ô, tách thành nhiều dòng theo 1 logic . (2 người xem)

[nguyenmanhcuong1993ls]

Cả nhà ơi, giúp mình với. Mình bán hàng trên shopee. File đơn hàng của shopee nhét tất cả các sản phẩm trong 1 đơn hàng vào 1 ô, mình muốn tách thành từng sản phẩm riêng ra từng dòng và gắn trạng thái đơn hàng lên từng sản phẩm trong đơn hàng để tính lãi. Trong trường hợp hàng chục nghìn đơn hàng, có những đơn hàng hơn 10 sản phẩm thì thật sự vất vả. Mong cả nhà giúp đỡ tôi với !!!!

Bài đã được tự động gộp: 12/3/19

@Ba Tê
@be09

Bài đã được tự động gộp: 12/3/19

các bác giúp tôi với ạ.

 

[snow25]

Cả nhà ơi, giúp mình với. Mình bán hàng trên shopee. File đơn hàng của shopee nhét tất cả các sản phẩm trong 1 đơn hàng vào 1 ô, mình muốn tách thành từng sản phẩm riêng ra từng dòng và gắn trạng thái đơn hàng lên từng sản phẩm trong đơn hàng để tính lãi. Trong trường hợp hàng chục nghìn đơn hàng, có những đơn hàng hơn 10 sản phẩm thì thật sự vất vả. Mong cả nhà giúp đỡ tôi với !!!!

Bài đã được tự động gộp: 12/3/19

@Ba Tê
@be09

Bài đã được tự động gộp: 12/3/19

các bác giúp tôi với ạ.

Bạn xem code nhé.

Sub tachdon()
    Dim arr, arr1, i As Long, j As Long, lr As Long, T, a As Long, k As Long
    With Sheets("orders")
         lr = .Range("J" & Rows.Count).End(xlUp).Row
         arr = .Range("A2:ab" & lr).Value
         ReDim arr1(1 To UBound(arr, 1) * 5, 1 To UBound(arr, 2))
    End With
    With Sheet2
         For i = 1 To UBound(arr, 1)
              T = Split(Chr(10) & "[" & arr(i, 10), Chr(10) & "[")
              a = a + 1
              For j = 1 To UBound(arr, 1)
               arr1(a, j) = arr(i, j)
              Next j
                  arr1(a, 10) = T(1)
              For k = 2 To UBound(T)
                  a = a + 1
                  For j = 1 To 5
                      arr1(a, j) = arr(i, j)
                  Next j
                      arr1(a, 10) = T(k)
              Next k
         Next i
         lr = .Range("J" & Rows.Count).End(xlUp).Row
         If lr > 1 Then .Range("A2:Ab" & lr).ClearContents
         If a Then .Range("A2").Resize(a, UBound(arr, 2)).Value = arr1
     End With
End Sub

 

[nguyenmanhcuong1993ls]

bạn ơi, mình chạy thì vướng lỗi này. b xem sao thế ạ.

Bài đã được tự động gộp: 13/3/19

máy mình báo nguy hiểm dòng đỏ như này là sao b nhỉ???

 

[snow25]

View attachment 213490View attachment 213490bạn ơi, mình chạy thì vướng lỗi này. b xem sao thế ạ.

Bạn gửi File lên nhé.Khả năng là thiếu vùng dữ liệu khai báo.Bạn sửa câu này xem được không.

ReDim arr1(1 To UBound(arr, 1) * 50, 1 To UBound(arr, 2))

 

[nguyenmanhcuong1993ls]

file này mới khoảng 1/20 thôi b, b chú ý xem. mình sợ nhầm lắm vì sai hết tiền lãi lỗ

 

[snow25]

file này mới khoảng 1/20 thôi b, b chú ý xem. mình sợ nhầm lắm vì sai hết tiền lãi lỗ

Bạn chạy code này nhé.

Sub tachdon()
    Dim arr, arr1, i As Long, j As Long, lr As Long, T, a As Long, k As Long
    With Sheets("orders")
         lr = .Range("J" & Rows.Count).End(xlUp).Row
         arr = .Range("A2:ab" & lr).Value
         ReDim arr1(1 To UBound(arr, 1) * 5, 1 To UBound(arr, 2))
    End With
    With Sheet2
         For i = 1 To UBound(arr, 1)
              T = Split(Chr(10) & "[" & arr(i, 10), Chr(10) & "[")
              a = a + 1
              For j = 1 To UBound(arr, 2)
               arr1(a, j) = arr(i, j)
              Next j
                  arr1(a, 10) = T(1)
              For k = 2 To UBound(T)
                  a = a + 1
                  For j = 1 To 5
                      arr1(a, j) = arr(i, j)
                  Next j
                      arr1(a, 10) = T(k)
              Next k
         Next i
         lr = .Range("J" & Rows.Count).End(xlUp).Row
         If lr > 1 Then .Range("A2:Ab" & lr).ClearContents
         If a Then .Range("A2").Resize(a, UBound(arr, 2)).Value = arr1
     End With
End Sub

 

[nguyenmanhcuong1993ls]

bị báo lỗi code b ạ.

 

[snow25]

View attachment 213495View attachment 213495View attachment 213496bị báo lỗi code b ạ.

Tên sheets bị sai.

With Sheet2

Bạn sửa sao cho hợp lý nhé.

 

[Ba Tê]

file này mới khoảng 1/20 thôi b, b chú ý xem. mình sợ nhầm lắm vì sai hết tiền lãi lỗ

Không xài file .xls, bỏ Excel 2003 đi.

 

[concogia]

Không xài file .xls, bỏ Excel 2003 đi.

Hình như thay ChrW(10) bằng "" rồi Slip bằng "[" là ....."dính chưởng" hay sao í. Xem ở cell [J4] có 3 đơn hàng nhưng tách thành 6. Híc
Thân

 

[Ba Tê]

Hình như thay ChrW(10) bằng "" rồi Slip bằng "[" là ....."dính chưởng" hay sao í. Xem ở cell [J4] có 3 đơn hàng nhưng tách thành 6. Híc
Thân

Híc! Không thấy trong dữ liệu có tùm lum dấu móc đơn.
"Mần" lại cái nữa coi sao.

 

[HieuCD]

Cả nhà ơi, giúp mình với. Mình bán hàng trên shopee. File đơn hàng của shopee nhét tất cả các sản phẩm trong 1 đơn hàng vào 1 ô, mình muốn tách thành từng sản phẩm riêng ra từng dòng và gắn trạng thái đơn hàng lên từng sản phẩm trong đơn hàng để tính lãi. Trong trường hợp hàng chục nghìn đơn hàng, có những đơn hàng hơn 10 sản phẩm thì thật sự vất vả. Mong cả nhà giúp đỡ tôi với !!!!

Bài đã được tự động gộp: 12/3/19

@Ba Tê
@be09

Bài đã được tự động gộp: 12/3/19

các bác giúp tôi với ạ.

Không đặt tên sheet bằng tiếng Việt có dấu

Sub TachHang()
  Dim sArr(), Res(), i As Long, j As Long, k As Long
  Const shName As String = "KetQua" 'Ten Sheet Ket Qua
  
  With Sheets("orders")
    sArr = .Range("A2:AB" & .Range("J" & Rows.Count).End(xlUp).Row).Value
  End With
  k = 0
  For i = 1 To UBound(sArr, 1)
    sArr(i, 10) = Split(Chr(10) & sArr(i, 10), Chr(10))
    k = k + UBound(sArr(i, 10)) + 1
  Next i
  ReDim Res(1 To k, 1 To UBound(sArr, 2))
  k = 0
  For i = 1 To UBound(sArr, 1)
    k = k + 1
    For j = 1 To UBound(sArr, 2)
      If j <> 10 Then Res(k, j) = sArr(i, j)
    Next j
    For j = 1 To UBound(sArr(i, 10))
      If j > 1 Then k = k + 1
      Res(k, 10) = sArr(i, 10)(j)
    Next j
  Next i
    With Sheets(shName)
      i = .Range("J" & Rows.Count).End(xlUp).Row
      If i > 1 Then .Range("A2:Ab" & i).ClearContents
      .Range("A2:AB2").Resize(k) = Res
    End With
End Sub

 

[be_09]

Cả nhà ơi, giúp mình với. Mình bán hàng trên shopee. File đơn hàng của shopee nhét tất cả các sản phẩm trong 1 đơn hàng vào 1 ô, mình muốn tách thành từng sản phẩm riêng ra từng dòng và gắn trạng thái đơn hàng lên từng sản phẩm trong đơn hàng để tính lãi. Trong trường hợp hàng chục nghìn đơn hàng, có những đơn hàng hơn 10 sản phẩm thì thật sự vất vả. Mong cả nhà giúp đỡ tôi với !!!!.

1/ Bị màu đỏ như hình bài 3 là do Office không có bản quyền.
2/ Thử một cách khác: Copy dữ liệu từ phần mềm xuất ra và Paste vào sheet Orders rồi sang sheet Ket_Qua nhấn nút Tách để xem thử kết quả.

 

[nguyenmanhcuong1993ls]

oke, cám ơn anh Be09 ạ.