Xin giúp đỡ Transpose từ Cột sang dòng có điều kiện

[nhnn1986]

Xin chào Anh/Chị:

Em có file dữ liệu cần chuyển từ Cột sang Dòng thỏa điều kiện sau:
Nếu giá trị A2 = A3= A4 (A2, A3, A4 chắc chắn bằng nhau) thì G2 = A2 chuyển giá trị cột E range(E2:E4) thành dòng range(H2:J2)
Nếu giá trị A5 = A6= A7 (A5, A6, A7 chắc chắn bằng nhau) thì G3 = A5 chuyển giá trị cột E range(E5:E7) thành dòng range(H3:J3) ...
Tiếp tục cách 3 dòng lặp đi lặp lại tới dòng cuối cùng (mỗi lần lặp là 3 dòng), dòng cuối cùng có thể thay đổi có khi chỉ 210 dòng,có khi trên 500 dòng tùy tháng báo cáo.

Giúp em chuyển dữ liệu dư trên bằng Code VBA được không ạ. Em đính kèm file và xin cảm ơn Anh/Chị trước ạ

 

[giaiphap]

Xin chào Anh/Chị:

Em có file dữ liệu cần chuyển từ Cột sang Dòng thỏa điều kiện sau:
Nếu giá trị A2 = A3= A4 (A2, A3, A4 chắc chắn bằng nhau) thì G2 = A2 chuyển giá trị cột E range(E2:E4) thành dòng range(H2:J2)
Nếu giá trị A5 = A6= A7 (A5, A6, A7 chắc chắn bằng nhau) thì G3 = A5 chuyển giá trị cột E range(E5:E7) thành dòng range(H3:J3) ...
Tiếp tục cách 3 dòng lặp đi lặp lại tới dòng cuối cùng (mỗi lần lặp là 3 dòng), dòng cuối cùng có thể thay đổi có khi chỉ 210 dòng,có khi trên 500 dòng tùy tháng báo cáo.

Giúp em chuyển dữ liệu dư trên bằng Code VBA được không ạ. Em đính kèm file và xin cảm ơn Anh/Chị trước ạ

Bạn xem thử file đúng yêu cầu của mình chưa.

 

[nhnn1986]

Tuyệt ạ, tuy không viết vằng code nhưng kết quả như mong đợi rồi. Chịu khó kéo công thức vậy ạ

Thanks @giaiphap

 

[HieuCD]

Xin chào Anh/Chị:

Em có file dữ liệu cần chuyển từ Cột sang Dòng thỏa điều kiện sau:
Nếu giá trị A2 = A3= A4 (A2, A3, A4 chắc chắn bằng nhau) thì G2 = A2 chuyển giá trị cột E range(E2:E4) thành dòng range(H2:J2)
Nếu giá trị A5 = A6= A7 (A5, A6, A7 chắc chắn bằng nhau) thì G3 = A5 chuyển giá trị cột E range(E5:E7) thành dòng range(H3:J3) ...
Tiếp tục cách 3 dòng lặp đi lặp lại tới dòng cuối cùng (mỗi lần lặp là 3 dòng), dòng cuối cùng có thể thay đổi có khi chỉ 210 dòng,có khi trên 500 dòng tùy tháng báo cáo.

Giúp em chuyển dữ liệu dư trên bằng Code VBA được không ạ. Em đính kèm file và xin cảm ơn Anh/Chị trước ạ

Chạy code

Sub GPE()
  Dim sArr(), Res()
  Dim i As Long, n As Long, k As Long, eRow As Long
 
  eRow = Range("G" & Rows.Count).End(xlUp).Row
  If eRow > 1 Then Range("G2:K" & eRow).ClearContents
 
  eRow = Range("A" & Rows.Count).End(xlUp).Row
  If eRow < 4 Then MsgBox ("Khong co du lieu"): Exit Sub
 
  sArr = Range("A2:E" & eRow).Value
  ReDim Res(1 To Int(UBound(sArr) / 3), 1 To 5)
 
  For i = 1 To UBound(sArr) Step 3
    k = k + 1
    Res(k, 1) = sArr(i, 1)
    Res(k, CLng(sArr(i, 3)) + 1) = sArr(i, 5)
    Res(k, CLng(sArr(i + 1, 3)) + 1) = sArr(i + 1, 5)
    Res(k, CLng(sArr(i + 2, 3)) + 1) = sArr(i + 2, 5)
    Res(k, 5) = (Res(k, 4) - Res(k, 3)) / Res(k, 2)
  Next i
  Range("G2:K2").Resize(k) = Res
End Sub

 

[befaint]

Cách 3: Pivot Table.

 

[nhnn1986]

Perfect code

Thanks Mr @HieuCD

Bài đã được tự động gộp: 11/10/18

Cách 3: Pivot Table.

Pivot thì em chịu ạ, chưa thử cái đó bao giờ hihi

 

[befaint]

Pivot thì em chịu ạ, chưa thử cái đó bao giờ

Pivot Table thì tầm 1 phút kéo kéo là xong.