Chuyển dữ liệu 1 cột thành nhiều cột (6 người xem)

gnnvietnam · 28/9/12

Hiện tại mình phải lọc lại nhiều file excel nên mình xin nhờ các bạn hướng dẫn giúp.
Mỗi một file chỉ có 1 cột và yêu cầu là copy 5 dòng sau đó paste lại với dạng Transpose như file mình đính kèm. Mong được sự hướng dẫn và giúp đỡ của các bạn.

Hoàng Trọng Nghĩa · 28/9/12

Vẫn chưa hiểu ý bạn lắm. Bạn cứ gửi thay vì mỗi file, bạn tạo 5 sheet mới và chép nội dung trong đó, thêm một sheet kết quả muốn đạt được như thế nào. Copy từ đâu, điều kiện là gì v.v... càng nói rõ chi tiết, càng tốt.

ndu96081631 · 28/9/12

Hoàng Trọng Nghĩa đã viết:
Vẫn chưa hiểu ý bạn lắm. Bạn cứ gửi thay vì mỗi file, bạn tạo 5 sheet mới và chép nội dung trong đó, thêm một sheet kết quả muốn đạt được như thế nào. Copy từ đâu, điều kiện là gì v.v... càng nói rõ chi tiết, càng tốt.

Tức là:
Copy A1:A5 Paste Transpose sang C1
Copy A6:A10 Paste Transpose sang C2
Copy A11:A15 Paste Transpose sang C3
vân vân... cho đến hết dữ liệu
----------
Định làm nhưng hình như TIÊU ĐỀ VỊ PHẠM NỘI QUY thì phải ---> Nghỉ làm cho chắc ăn
Ẹc... Ẹc...

Quang_Hải · 28/9/12

gnnvietnam đã viết:
Hiện tại mình phải lọc lại nhiều file excel nên mình xin nhờ các bạn hướng dẫn giúp.
Mỗi một file chỉ có 1 cột và yêu cầu là copy 5 dòng sau đó paste lại với dạng Transpose như file mình đính kèm. Mong được sự hướng dẫn và giúp đỡ của các bạn.

Bạn xài code này nhé

Hic, làm rồi mới để ý tiêu đề vi phạm nội quy, nếu bạn xem sớm thì tốt, nếu không bài bị xóa ráng chịu

PHP:

Sub doc_ngang()
On Error Resume Next
Dim dl, i, kq(1 To 10000, 1 To 5), j, k
dl = Range([a1], [a65536].End(3)).Value
For i = 1 To UBound(dl) Step 5
  k = k + 1
  For j = 1 To 5
    kq(k, j) = dl(i + j - 1, 1)
  Next
Next
[b1].Resize(k, 5) = kq
End Sub

ndu96081631 · 28/9/12

quanghai1969 đã viết:
Bạn xài code này nhé

Hic, làm rồi mới để ý tiêu đề vi phạm nội quy, nếu bạn xem sớm thì tốt, nếu không bài bị xóa ráng chịu

PHP:

Sub doc_ngang() On Error Resume Next Dim dl, i, kq(1 To 10000, 1 To 5), j, k dl = Range([a1], [a65536].End(3)).Value For i = 1 To UBound(dl) Step 5 k = k + 1 For j = 1 To 5 kq(k, j) = dl(i + j - 1, 1) Next Next [b1].Resize(k, 5) = kq End Sub

Code này nếu bỏ On Error Resume Next thì sẽ bị lỗi ---> Đố biết là lỗi gì? Cách khắc phục mà không dùng câu bẫy lỗi?
Ẹc... Ẹc...

Hoàng Trọng Nghĩa · 28/9/12

ndu96081631 đã viết:
Code này nếu bỏ On Error Resume Next thì sẽ bị lỗi ---> Đố biết là lỗi gì? Cách khắc phục mà không dùng câu bẫy lỗi?
Ẹc... Ẹc...

Em nghĩ sẽ bị lỗi tại cách khai báo (chắc gì số liệu là 10000). Lẽ ra nên khai báo KQ rồi Redim lại.

kq(1 To 10000, 1 To 5)

======================================

Sửa code lại sẽ không bị lỗi:

PHP:

Sub doc_ngang()
Dim dl, i, KQ, j, k, h
dl = Range([a1], [a65536].End(3)).Value
h = UBound(dl)
h = h - h Mod 5

ReDim KQ(1 To h, 1 To 5)

For i = 1 To h Step 5
  k = k + 1
  For j = 1 To 5
    KQ(k, j) = dl(i + j - 1, 1)
  Next
Next
[b1].Resize(k, 5) = KQ
End Sub

ndu96081631 · 28/9/12

Hoàng Trọng Nghĩa đã viết:
Em nghĩ sẽ bị lỗi tại cách khai báo (chắc gì số liệu là 10000). Lẽ ra nên khai báo KQ rồi Redim lại.

kq(1 To 10000, 1 To 5)

Lỗi này không nói làm gì ---> Thử nghĩ đến trường hợp số tổng dòng của DL không chia hết cho 5 ấy!

Ba Tê · 28/9/12

Hoàng Trọng Nghĩa đã viết:
Em nghĩ sẽ bị lỗi tại cách khai báo (chắc gì số liệu là 10000). Lẽ ra nên khai báo KQ rồi Redim lại.

kq(1 To 10000, 1 To 5)

Hổng phải do kq() mà do dl(i + j - 1, 1) sẽ chạy "qua khỏi" ubound(dl,1)
Làm thí cái này:

PHP:

Public Sub GPE444()
Dim Rng(), Arr(), i As Long, j As Long, k As Long, C As Long
Rng = Range([a1], [A65000].End(xlUp).Offset(5)).Value
C = UBound(Rng, 1)
ReDim Arr(1 To C, 1 To 5)
    For i = 1 To C - 5 Step 5
            k = k + 1
        For j = 1 To 5
                Arr(k, j) = Rng(i + j - 1, 1)
        Next j
    Next i
[C1].Resize(k, 5).Value = Arr
End Sub

Hoàng Trọng Nghĩa · 28/9/12

Ba Tê đã viết:
Hổng phải do kq() mà do dl(i + j - 1, 1) sẽ chạy "qua khỏi" ubound(dl,1)
Làm thí cái này:

PHP:

Public Sub GPE444() Dim Rng(), Arr(), i As Long, j As Long, k As Long, C As Long Rng = Range([a1], [A65000].End(xlUp).Offset(5)).Value C = UBound(Rng, 1) ReDim Arr(1 To C, 1 To 5) For i = 1 To C - 5 Step 5 k = k + 1 For j = 1 To 5 Arr(k, j) = Rng(i + j - 1, 1) Next j Next i [C1].Resize(k, 5).Value = Arr End Sub

Trời ơi, dĩ nhiên là lỗi đó là 1, tức hơn số 10000 dòng là out of range rồi. Mặt khác, mỗi Step 5 thì đương nhiên số dòng phải chia hết cho 5, nếu không thì sẽ lại phát sinh thêm lỗi lần nữa, cho nên Nghĩa đã sửa lại code ở bài #6 rồi còn gì nè:

h = UBound(dl)
h = h - h Mod 5

Quang_Hải · 28/9/12

ndu96081631 đã viết:
Lỗi này không nói làm gì ---> Thử nghĩ đến trường hợp số tổng dòng của DL không chia hết cho 5 ấy!

Em làm thế này để Redim đúng số dòng cần cho mảng kq luôn

PHP:

Sub doc_ngang()
Dim dl, i, kq(), j, k
dl = Range([a1], [a65536].End(3).Offset(5)).Value
ReDim kq(1 To (UBound(dl) - UBound(dl) Mod 5) / 5, 1 To 5)
  For i = 1 To UBound(dl) - UBound(dl) Mod 5 Step 5
    k = k + 1
    For j = 1 To 5
      kq(k, j) = dl(i + j - 1, 1)
    Next
  Next
[b1].Resize(k, 5) = kq
End Sub

ndu96081631 · 28/9/12

Hoàng Trọng Nghĩa đã viết:
Trời ơi, dĩ nhiên là lỗi đó là 1, tức hơn số 10000 dòng là out of range rồi. Mặt khác, mỗi Step 5 thì đương nhiên số dòng phải chia hết cho 5, nếu không thì sẽ lại phát sinh thêm lỗi lần nữa, cho nên Nghĩa đã sửa lại code ở bài #6 rồi còn gì nè:

h = UBound(dl)
h = h - h Mod 5

Làm như Ba Tê là đơn giản nhất, khỏi cần phải chế tác gì thêm cả
Có chăng là nên tính toán sao cho Array kết quả có số phần tử chiều thứ nhất vừa đủ, không thừa không thiếu mới là hoàn hảo (dùng INT để tính)

Quang_Hải · 28/9/12

Hoàng Trọng Nghĩa đã viết:
Em nghĩ sẽ bị lỗi tại cách khai báo (chắc gì số liệu là 10000). Lẽ ra nên khai báo KQ rồi Redim lại.

kq(1 To 10000, 1 To 5)

======================================

Sửa code lại sẽ không bị lỗi:

PHP:

Sub doc_ngang() Dim dl, i, KQ, j, k, h dl = Range([a1], [a65536].End(3)).Value h = UBound(dl) h = h - h Mod 5 ReDim KQ(1 To h, 1 To 5) For i = 1 To h Step 5 k = k + 1 For j = 1 To 5 KQ(k, j) = dl(i + j - 1, 1) Next Next [b1].Resize(k, 5) = KQ End Sub

Anh Nghiã không thêm Offset(5) thì sẽ mất dữ liệu phía dưới thôi

gnnvietnam · 28/9/12

Thanks bác Hoàng Trọng Nghĩa. Code run tốt nhưng chỉ là nó đếm đến dòng cuối cùng chia hết cho 5 thôi. Tổng cộng 13747 dòng thì nó chỉ copy đến 13745, còn 2 dòng cuối thì không copy qua. Có cách nào fix không bác ? VD như còn thêm 1 - 4 dòng nữa thì nó copy hết rồi dừng không ?

Hoàng Trọng Nghĩa · 28/9/12

gnnvietnam đã viết:
Thanks bác Hoàng Trọng Nghĩa. Code run tốt nhưng chỉ là nó đếm đến dòng cuối cùng chia hết cho 5 thôi. Tổng cộng 13747 dòng thì nó chỉ copy đến 13745, còn 2 dòng cuối thì không copy qua. Có cách nào fix không bác ? VD như còn thêm 1 - 4 dòng nữa thì nó copy hết rồi dừng không ?

À, thôi thì mình giết lầm còn hơn bỏ sót đi! Như vầy đi:

PHP:

Sub doc_ngang()
    Dim dl, i, KQ, j, k, h
    h = [A65536].End(3).Row
    h = h + IIf(h Mod 5 > 0, 5 - h Mod 5, 0)
    dl = Range("A1:A" & h).Value
    ReDim KQ(1 To h, 1 To 5)
    For i = 1 To h Step 5
        k = k + 1
        For j = 1 To 5
            KQ(k, j) = dl(i + j - 1, 1)
        Next
    Next
    [B1].Resize(k, 5) = KQ
End Sub

ndu96081631 · 28/9/12

Nếu tôi làm bài này thì sẽ làm khác chút (tổng quát)

PHP:

Sub ColumnToTable(ByVal SrcRng As Range, ByVal lTableCols As Long, ByVal Target As Range)
  Dim sArray, Arr()
  Dim i As Long, j As Long, n As Long, lRs As Long, lUb As Long
  SrcRng.Parent.AutoFilterMode = False
  sArray = SrcRng.Resize(, 1).Value
  If IsArray(sArray) Then
    lUb = UBound(sArray, 1)
    lRs = IIf(lUb Mod lTableCols = 0, lUb / lTableCols, Int(lUb / lTableCols) + 1)
    ReDim Arr(1 To lRs, 1 To lTableCols)
    For i = 1 To lUb Step lTableCols
      n = n + 1
      For j = 1 To lTableCols
        If i + j - 1 <= lUb Then Arr(n, j) = sArray(i + j - 1, 1)
      Next
    Next
    Target.Resize(lRs, lTableCols).Value = Arr
  End If
End Sub

PHP:

Sub Main()
  Dim SrcRng As Range, lTableCols As Long, Target As Range
  Set SrcRng = Sheet1.Range("A1:A20000")
  Set Target = Sheet1.Range("C1")
  lTableCols = 5
  ColumnToTable SrcRng, lTableCols, Target
End Sub

------------------
Có 1 chuyện rất buồn cười
Trong code của Ba Tê có đoạn:

Mã:

[COLOR=#ff0000]C = UBound(Rng, 1)[/COLOR]
ReDim Arr(1 To C, 1 To 5)
[COLOR=#ff0000]For i = 1 To C - 5 Step 5[/COLOR]

Để ý 2 dòng màu đỏ nha!
Giả sử rằng C = 3 (tức có 3 dòng dữ liệu thì For i = 1 To C - 5 Step 5, tức For i = 1 To (3 - 5) Step 5, tức For i = 1 To -2 Step 5
Có buồn cười không? Ấy vậy mà cha Bill vẫn hiểu và code vẫn chạy... phà phà

gnnvietnam · 28/9/12

cám ơn bác nhiều, cái này chạy đúng ý mình lắm, nhờ nó cv nhẹ hẵn đi ^^

ndu96081631 · 28/9/12

ndu96081631 đã viết:
Giả sử rằng C = 3 (tức có 3 dòng dữ liệu thì For i = 1 To C - 5 Step 5, tức For i = 1 To (3 - 5) Step 5, tức For i = 1 To -2 Step 5
Có buồn cười không? Ấy vậy mà cha Bill vẫn hiểu và code vẫn chạy... phà phà

Ah... phát hiện ra rồi
Thì ra ổng chơi tà đạo chổ này:
Rng = Range([A1], [A65000].End(xlUp).Offset(5)).Value
Ẹc... Ẹc....

siwtom · 28/9/12

ndu96081631 đã viết:
Nếu tôi làm bài này thì sẽ làm khác chút (tổng quát)

PHP:

Sub ColumnToTable(ByVal SrcRng As Range, ByVal lTableCols As Long, ByVal Target As Range) Dim sArray, Arr() Dim i As Long, j As Long, n As Long, lRs As Long, lUb As Long SrcRng.Parent.AutoFilterMode = False sArray = SrcRng.Resize(, 1).Value If IsArray(sArray) Then lUb = UBound(sArray, 1) lRs = IIf(lUb Mod lTableCols = 0, lUb / lTableCols, Int(lUb / lTableCols) + 1) ReDim Arr(1 To lRs, 1 To lTableCols) For i = 1 To lUb Step lTableCols n = n + 1 For j = 1 To lTableCols If i + j - 1 <= lUb Then Arr(n, j) = sArray(i + j - 1, 1) Next Next Target.Resize(lRs, lTableCols).Value = Arr End If End Sub

PHP:

Sub Main() Dim SrcRng As Range, lTableCols As Long, Target As Range Set SrcRng = Sheet1.Range("A1:A20000") Set Target = Sheet1.Range("C1") lTableCols = 5 ColumnToTable SrcRng, lTableCols, Target End Sub

------------------
Có 1 chuyện rất buồn cười
Trong code của Ba Tê có đoạn:

Mã:

[COLOR=#ff0000]C = UBound(Rng, 1)[/COLOR] ReDim Arr(1 To C, 1 To 5) [COLOR=#ff0000]For i = 1 To C - 5 Step 5[/COLOR]

Để ý 2 dòng màu đỏ nha!
Giả sử rằng C = 3 (tức có 3 dòng dữ liệu thì For i = 1 To C - 5 Step 5, tức For i = 1 To (3 - 5) Step 5, tức For i = 1 To -2 Step 5
Có buồn cười không? Ấy vậy mà cha Bill vẫn hiểu và code vẫn chạy... phà phà

Không test nhưng tôi nhìn qua thì thấy code của ndu chuẩn rồi.
--------
Tất nhiên nếu dùng Int thì cũng có thể rút gọn (?) thành
lRs = Int((lUb - 1) / lTableCols) + 1
Nhưng tôi hay dùng toán tử "\" nên tôi hay viết
lRs = (lUb - 1) \ lTableCols + 1
-------------
Tất nhiên đây là chuyện nhỏ "tí tẹo", nói ra để biết thôi.

Hoàng Trọng Nghĩa · 28/9/12

siwtom đã viết:
Không test nhưng tôi nhìn qua thì thấy code của ndu chuẩn rồi.
--------
Tất nhiên nếu dùng Int thì cũng có thể rút gọn (?) thành
lRs = Int((lUb - 1) / lTableCols) + 1
Nhưng tôi hay dùng toán tử "\" nên tôi hay viết
lRs = (lUb - 1) \ lTableCols + 1
-------------
Tất nhiên đây là chuyện nhỏ "tí tẹo", nói ra để biết thôi.

Hoàn toàn chính xác, toán tử "\" có chức năng chia số trước cho số sau nhưng chỉ lấy phần nguyên:

X = 4\3 (X sẽ nhận giá trị là 1)

Y = 10\3 (Y sẽ nhận giá trị là 3).

Chuyển dữ liệu 1 cột thành nhiều cột (6 người xem)

Người dùng đang xem chủ đề này

Thành viên mới

File đính kèm

Chuyên gia GPE

Huyền thoại GPE

Thành viên gạo cội

Huyền thoại GPE

Chuyên gia GPE

Huyền thoại GPE

Cạo Rồi Khỏi Gội

Chuyên gia GPE

Thành viên gạo cội

Huyền thoại GPE

Thành viên gạo cội

Thành viên mới

Chuyên gia GPE

Huyền thoại GPE

Thành viên mới

Huyền thoại GPE

Thành viên gắn bó

Chuyên gia GPE

Đếm ngược thời gian