Em xin code chuyển dữ liệu theo yêu cầu ạ!

[mandala]

Em có bài toán chuyển dữ liệu theo yêu cầu từ cột sang hàng
Em gửi file excel kèm theo. Xin nhờ mọi người giúp đỡ ạ
Em xin cảm ơn !
ps: Em có tìm kiếm trên diễn đàm rồi nhưng vẫn chưa làm được nên mới đăng lên nhờ mọi người ạ!

Em xin code chuyển đổi như hình mẫu ạ!

 

[anhtuanle123]

xem thử bạn !

 

[mandala]

xem thử bạn !

Cảm ơn anh đã giúp đỡ!
Có một vấn đề mong anh chỉ giúp
Khi em thử với dữ liệu ngắn thì dòng Bộ sản phẩm cách xuống 2 dòng


Em thử đổi code: For i = 8 To last_row - 1
đổi thành: For i = 8 To last_row - 2
thì đoạn ngắn khoảng cách còn 1 dòng

Nhưng khi em thay bằng dữ liệu dài thì nó lại thiếu


Anh chỉnh code hộ em sao cho dòng Bộ sản phẩm bao gồm cách dòng trên 1 dòng với ạ
em xin cảm ơn!

 

[HieuCD]

Em có bài toán chuyển dữ liệu theo yêu cầu từ cột sang hàng
Em gửi file excel kèm theo. Xin nhờ mọi người giúp đỡ ạ
Em xin cảm ơn !
ps: Em có tìm kiếm trên diễn đàm rồi nhưng vẫn chưa làm được nên mới đăng lên nhờ mọi người ạ!

Em xin code chuyển đổi như hình mẫu ạ!

View attachment 210424

Thử code

Sub GPE()
  Dim sArr(), Res()
  Dim i As Long, k As Long, j As Long, sColRes As Long
  Const dCol As Byte = 3 'Khai báo Khoang cách 2 cot ket qua
  Const nCol As Long = 4 'Khai báo só cot ket qua
  Const boSP As String = "B? s?n ph?m bao g?m"
 
  sColRes = (nCol - 1) * dCol + 1
  sArr = Range("A8", Range("A1040000").End(xlUp)).Value
  ReDim Res(1 To UBound(sArr), 1 To sColRes)
 
  k = 1: j = 0
  For i = 1 To UBound(sArr)
    If Not (sArr(i, 1) Like boSP) Then
      If j = nCol Then j = 1:  k = k + 1 Else j = j + 1
      Res(k, (j - 1) * dCol + 1) = sArr(i, 1)
    Else
      k = k + 1
      Res(k + 1, 1) = sArr(i, 1)
      For n = i + 1 To UBound(sArr)
        k = k + 1
        Res(k, dCol + 1) = sArr(n, 1)
      Next n
      Exit For
    End If
  Next i
  Range("D7:AA10000").ClearContents
  Range("D7").Value = Range("A7").Value
  If k Then Range("D9").Resize(k, sColRes) = Res
End Sub

 

[anhtuanle123]

bạn thử đảo đoạn code như vầy là nó ra nè !

 

[mandala]

Xin cảm ơn sự giúp đỡ nhiệt tình của anh anhtuanle123 và anh HieuCD
Chúc hai anh có một ngày thứ 7 vui vẻ.