Xin giúp đỡ chuyển hàng thành cột ( code VBA)

Liên hệ QC

tuoigiyeuem

Thành viên chính thức
Tham gia
19/12/08
Bài viết
99
Được thích
4
Em có 1 bảng Excel ( file đính kèm). Nhờ các ACE viết code chuyển hàng thành cột giúp em ( kết quả em muốn như phần tô màu vàng trong file). Vì dữ liệu file excel của em rất lớn nên dùng công cụ Paste Special -> Transpose sẽ rất lâu nên em muốn dùng code cho nhanh.
Mong ACE giúp đỡ.
 

File đính kèm

  • HangThanhCot.xls
    56 KB · Đọc: 129
Em có 1 bảng Excel ( file đính kèm). Nhờ các ACE viết code chuyển hàng thành cột giúp em ( kết quả em muốn như phần tô màu vàng trong file). Vì dữ liệu file excel của em rất lớn nên dùng công cụ Paste Special -> Transpose sẽ rất lâu nên em muốn dùng code cho nhanh.
Mong ACE giúp đỡ.
Tặng bạn code này, chỉ xài được cho dữ liệu y như trong file thôi nghe.
[GPECODE=vb]Public Sub GPE()
Dim sArr(), dArr(), I As Long, K As Long, CoL As Long, MaxCoL As Long
sArr = Range([B3], [B65536].End(xlUp)).Offset(, -1).Resize(, 2).Value2
ReDim dArr(1 To UBound(sArr, 1), 1 To 10)
For I = 1 To UBound(sArr, 1)
If sArr(I, 1) <> Empty Then
K = I: CoL = 1
dArr(K, 1) = sArr(I, 2)
Else
If sArr(I, 2) <> Empty Then
CoL = CoL + 1
If CoL > MaxCoL Then MaxCoL = CoL
dArr(K, CoL) = sArr(I, 2)
End If
End If
Next I
[C3].Resize(10000, 10).ClearContents
[C3].Resize(K, MaxCoL) = dArr
End Sub[/GPECODE]
 
Upvote 0
Cám ơn anh. A có thể giải thích code giúp em để em học hỏi được không
 

File đính kèm

  • HangThanhCot2.xls
    56.5 KB · Đọc: 77
Lần chỉnh sửa cuối:
Upvote 0
Em có 1 bảng Excel ( file đính kèm). Nhờ các ACE viết code chuyển hàng thành cột giúp em ( kết quả em muốn như phần tô màu vàng trong file). Vì dữ liệu file excel của em rất lớn nên dùng công cụ Paste Special -> Transpose sẽ rất lâu nên em muốn dùng code cho nhanh.
Mong ACE giúp đỡ.

góp thêm một đạon code nhỏ
Mã:
Sub Macro2()
Dim ng As Variant, kq(), i, j, k, ColNu As Long

ng = [a3].Resize([b60000].End(3).Row, 2).Value

For i = 1 To UBound(ng)
    If Val(ng(i, 1)) Then
   ' MsgBox ng(i, 1)
    k = 0
        For j = i To UBound(ng)
            If j > i And Val(ng(j, 1)) Then Exit For
            If IsEmpty(ng(j, 2)) Then Exit For
            k = k + 1
            If k > ColNu Then ColNu = k: ReDim Preserve kq(1 To UBound(ng), 1 To ColNu)
            kq(i, k) = ng(j, 2)
        Next
    End If
Next

[c3].Resize(UBound(ng), ColNu).Value = kq
End Sub

=================
còn code của bác "BaPhi" tách sai là do A31 không phải là cell rổng
 
Lần chỉnh sửa cuối:
Upvote 0
góp thêm một đạon code nhỏ

=================
còn code của bác "BaPhi" tách sai là do A31 không phải là cell rổng
Tui cũng "sợ" nên có nói trước:
Tặng bạn code này, chỉ xài được cho dữ liệu y như trong file thôi nghe.
Ai ngờ thêm mấy cái dsdsdsdsdsdsdsdsdsdsdsdsdsdsdsdsdsdsdsdsdsdsdsdsdsdsdsdsdsdsdsd..... gì đó mà trong cột A lại "phá đài" bằng cái dấu cách. HÍC!
 
Lần chỉnh sửa cuối:
Upvote 0
Thấy bài này cũng dễ ăn nên xía vô 1 bài coi. Nhờ ăn cắp thuật toán của anh Ba Tê nên mới viết được code này.
PHP:
Sub QH()
Dim Data(), Res(), I As Long, K As Long
Dim C As Long, MaxC As Long, MaxR As Long
[A3:A65536].Replace Space(1), Space(0)
Data = Range([A3], [B65536].End(xlUp)).Value
MaxR = UBound(Data): ReDim Res(1 To MaxR, 1 To 1)
For I = 1 To UBound(Data, 1)
    If Data(I, 1) <> "" Then
        K = I: C = 1
        Res(K, 1) = Data(I, 2)
    Else
         C = C + 1
         MaxC = IIf(C > MaxC, C, MaxC)
         ReDim Preserve Res(1 To MaxR, 1 To MaxC)
         Res(K, C) = Data(I, 2)
    End If
Next
[C3].Resize(K, MaxC) = Res
End Sub
 
Upvote 0
Mình có số liệu xử lý cũng gần tương tự như chủ topic, dữ liệu mình liên tục chứ không có dòng rỗng xen kẽ và ở cột A những dòng nào có số giống nhau thì chuyển thành số cột tương ứng.
Mong được các bạn giúp đỡ!
 

File đính kèm

  • HangThanhCot.xls
    42.5 KB · Đọc: 23
Upvote 0
sao không dùng vba kết hợp với paste special nhỉ?
 
Lần chỉnh sửa cuối:
Upvote 0
Em có 1 bảng Excel ( file đính kèm). Nhờ các ACE viết code chuyển hàng thành cột giúp em , 2 dòng đầu chuyển hàng thành cột kèm theo đảo vị trí ngược lại, 2 hàng kế kế chuyển hàng thành cột nối tiếp vô( thể hiện trong file đính kèm).Vì dữ liệu file excel của em rất lớn nên dùng công cụ Paste Special -> Transpose sẽ rất lâu nên em muốn dùng code cho nhanh. E xin cảm ơn
 

File đính kèm

  • a.xls
    30.5 KB · Đọc: 15
Upvote 0
Em có 1 bảng Excel ( file đính kèm). Nhờ các ACE viết code chuyển hàng thành cột giúp em , 2 dòng đầu chuyển hàng thành cột kèm theo đảo vị trí ngược lại, 2 hàng kế kế chuyển hàng thành cột nối tiếp vô( thể hiện trong file đính kèm).Vì dữ liệu file excel của em rất lớn nên dùng công cụ Paste Special -> Transpose sẽ rất lâu nên em muốn dùng code cho nhanh. E xin cảm ơn
Trong file của bạn, sau khi chuyển đổi, sô liệu dòng 2 và 3 không còn đi theo nhau nữa có đúng vậy không bạn.
 
Upvote 0
Mình có 1 file Excel, muốn gộp các hàng thành 1 cột
Nhờ A E giúp đỡ
 

File đính kèm

  • GHEP HANG.xlsx
    8.7 KB · Đọc: 10
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom