Giúp em chuyển nhiều cột liên tiếp thành 3 cột với ạ (1 người xem)

[friendship293a]

như tiêu đề em muốn chuyển dữ liệu từ 3 cột liên tiếp thành 3 cột các anh biết giúp e vơi.

 

[Let'GâuGâu]

như tiêu đề em muốn chuyển dữ liệu từ 3 cột liên tiếp thành 3 cột các anh biết giúp e vơi.

hối gấp mà đi đâu mất tiêu rồi????????????/chừng nào rảnh coi được ko nha

 

[friendship293a]

Hàm của anh khó hiểu quá e muốn bổ xung dữ liệu mà chả biết sửa thế nào hic

 

[Quang_Hải]

như tiêu đề em muốn chuyển dữ liệu từ 3 cột liên tiếp thành 3 cột các anh biết giúp e vơi.

Nếu biết xài code thì copy code này về, bấm nút cái là xong
Nếu có nhiều cột dữ liệu thì tự sửa lại trong code là được. Kết quả xuất ra tại cột P, bạn thay đổi tuỳ thích
Code thì có vẻ dễ chỉnh sửa hơn hàm, nhìn hàm chóng mặt quá

Sub chuyen()
Dim Sarr(), Darr(), I, J, X, Y
With Sheets("sheet1")
    Sarr = .Range(.[A4], .[O65536].End(3)).Value
End With
ReDim Darr(1 To 65536, 1 To 3)
For Y = 1 To UBound(Sarr, 2) Step 3
    For I = 1 To UBound(Sarr)
        J = J + 1
        For X = 1 To 3
            Darr(J, X) = Sarr(I, Y + X - 1)
        Next
    Next
Next
Sheets("sheet1").[P4].Resize(J, 3) = Darr
End Sub

 

[friendship293a]

Code của bác chạy ngon đấy nhưng e không hiểu thay đổi số cột và số dòng của đầu vào thì thay đổi số nào trong code

 

[Quang_Hải]

Code của bác chạy ngon đấy nhưng e không hiểu thay đổi số cột và số dòng của đầu vào thì thay đổi số nào trong code

1. Bạn có thử thêm số dòng của đầu vào chưa? Kết quả sau khi chay code như thế nào?
2. Bạn có thử đọc code và so sánh với với dữ liệu ban đầu trong file bạn gởi chưa. File mẫu của bạn từ cột A đến cột O, và trong code cũng thể hiện rất rõ tại dòng code này
Sarr = .Range(.[A4], .[O65536].End(3)).Value

 

[ptm0412]

ReDim Darr(1 To 65536, 1 To 3)

Có thể tính số dòng tối đa cho DArr bằng:

DCount = Sheets("sheet1").Range(.[A4], .[O65536].End(3)).Count / 3

Sau đó ReDim vừa đủ, chứ ReDim chi tới 65 ngàn dòng:

ReDim Darr(1 To DCount, 1 To 3)

 

[Let'GâuGâu]

Hàm của anh khó hiểu quá e muốn bổ xung dữ liệu mà chả biết sửa thế nào hic

hồi chiều làm gấp gấp, quên chỉnh lại

1-đặt name (nhấn phím F3 để xem)
mydata=Sheet1!$A$4:$O$7
2-cthức cho cột thứ 1
F11=INDEX(mydata,MOD(ROW(1:1)-1,ROWS(mydata))+1,INT((ROW(1:1)-1)/ROWS(mydata))*3+1)

cái số 4 trong cthức cũ là số hàng

 

[sealand]

Bạn dùng Code chép trực tiếp xem sao:

Sub TransData()
Dim Cl As Range, mRg As Range, i
Sheet2.Range("A10:C" & Rows.Count).ClearContents
Set mRg = Application.InputBox("Chon vung chuyen, luu y co 15 cot", , , , , , , 8)
For i = 1 To 15 Step 3
Set Cl = Sheet2.Cells(Cells.Rows.Count, "A").End(3).Offset(1)
If Cl.Row < 10 Then Set Cl = Sheet2.[A10]
mRg.Cells(1, i).Resize(mRg.Rows.Count, 3).Copy Cl
Next
End Sub

 

[sealand]

Nếu dùng công thức thì từ ô nào đó cần lấy kết quả ta đặt công thức:

=IF(ROW(1:1)<21,OFFSET($A$2,MOD(ROW(1:1)-1,4),0,1,COLUMNS(1:1)-1),"")

Sau đó chép sang ngay 3 cột và chép dài xuống dưới là được.