Chuyển dữ liệu giữa các sheet từ cột thành hàng và hàng thành cột. . .

zPeterPan · 18/7/21

Em xin nhờ các Thầy cô và các anh chị trên diễn đàn giúp em với ạ. . .
Như tiêu đề ở trên emm muốn chuyển dữ liệu từ cột ("A3:A10000") của sheet1 sang dòng 5 của sheet2
và chuyển dữ liệu từ dòng ("C3:CZ10000") của sheet1 sang dạng cột từ dòng 6 của sheet2
(Số lượng cột và hàng là không cố định ạ. . .)

Đây là kết quả em mong muốn ạ. . .

https://www.mediafire.com/file/n8day1jbehso3iy/ChuyenData.xlsm/file
Do file dung lượng lớn nên em chuyển lên mediafire ạ . . . em cảm ơn ạ. . .

Hoàng Tuấn 868 · 18/7/21

zPeterPan đã viết:
Em xin nhờ các Thầy cô và các anh chị trên diễn đàn giúp em với ạ. . .
Như tiêu đề ở trên emm muốn chuyển dữ liệu từ cột ("A3:A10000") của sheet1 sang dòng 5 của sheet2
và chuyển dữ liệu từ dòng ("C3:CZ10000") của sheet1 sang dạng cột từ dòng 6 của sheet2
(Số lượng cột và hàng là không cố định ạ. . .)

View attachment 262635
Đây là kết quả em mong muốn ạ. . .
View attachment 262636

https://www.mediafire.com/file/n8day1jbehso3iy/ChuyenData.xlsm/file
Do file dung lượng lớn nên em chuyển lên mediafire ạ . . . em cảm ơn ạ. . .

Bạn copy, paste transpose, xóa dòng và cột không dùng chỉ hết khoảng 30 giây thôi mà, đâu cần đến code nhỉ.

zPeterPan · 18/7/21

Hoàng Tuấn 868 đã viết:
Bạn copy, paste transpose, xóa dòng và cột không dùng chỉ hết khoảng 30 giây thôi mà, đâu cần đến code nhỉ.

Nhưng làm như vậy sẽ dung lượng file tăng nhiều lắm ạ. Và số lượng cột và hàng không cố định ạ

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

Hoàng Tuấn 868 · 18/7/21

zPeterPan đã viết:
Nhưng làm như vậy sẽ dung lượng file len nhiều lắm ạ

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

Nếu bạn nghĩ vậy thì mình ... chạy.

zPeterPan · 21/7/21

Hoàng Tuấn 868 đã viết:
Nếu bạn nghĩ vậy thì mình ... chạy.

Nhưng em không biết cho vào mảng như nào. . . . Vì em cũng làm theo kiểu reco macro thì chỉ xử lý tầm 100 cột và 200 dòng thì cũng được. Nhưng khi xử lý khoảng 5000 đến 7000 dòng sang 5000 đến 7000 cột thì lâu lắm ạ chờ từ 10 đến hơn 20 phút ạ. . .

HieuCD · 21/7/21

zPeterPan đã viết:
Em xin nhờ các Thầy cô và các anh chị trên diễn đàn giúp em với ạ. . .
Như tiêu đề ở trên emm muốn chuyển dữ liệu từ cột ("A3:A10000") của sheet1 sang dòng 5 của sheet2
và chuyển dữ liệu từ dòng ("C3:CZ10000") của sheet1 sang dạng cột từ dòng 6 của sheet2
(Số lượng cột và hàng là không cố định ạ. . .)

View attachment 262635
Đây là kết quả em mong muốn ạ. . .
View attachment 262636

https://www.mediafire.com/file/n8day1jbehso3iy/ChuyenData.xlsm/file
Do file dung lượng lớn nên em chuyển lên mediafire ạ . . . em cảm ơn ạ. . .

Chạy code

Mã:

Sub ABC()
  Dim sArr(), ngay(), res() As String, sRow&, sCol&, i&, j&
 
  With Sheet1
    i = .Range("A" & Rows.Count).End(xlUp).Row
    j = .Cells(3, Columns.Count).End(xlToLeft).Column
    sArr = .Range("A3", .Cells(i, j)).Value
  End With
  sRow = UBound(sArr):  sCol = UBound(sArr, 2)
  ReDim ngay(1 To 1, 1 To sRow)
  ReDim res(1 To sCol - 2, 1 To sRow)
  For i = 1 To sRow
    ngay(1, i) = sArr(i, 1)
    For j = 3 To sCol
      res(j - 2, i) = sArr(i, j)
    Next j
  Next i
  With Sheet2
    .UsedRange.Clear
    .Range("A5").Resize(, sRow) = ngay
    .Range("A6").Resize(sCol - 2, sRow) = res
  End With
End Sub

HUONGHCKT · 21/7/21

zPeterPan đã viết:
Em xin nhờ các Thầy cô và các anh chị trên diễn đàn giúp em với ạ. . .
Như tiêu đề ở trên emm muốn chuyển dữ liệu từ cột ("A3:A10000") của sheet1 sang dòng 5 của sheet2
và chuyển dữ liệu từ dòng ("C3:CZ10000") của sheet1 sang dạng cột từ dòng 6 của sheet2
(Số lượng cột và hàng là không cố định ạ. . .)

View attachment 262635
Đây là kết quả em mong muốn ạ. . .
View attachment 262636

https://www.mediafire.com/file/n8day1jbehso3iy/ChuyenData.xlsm/file
Do file dung lượng lớn nên em chuyển lên mediafire ạ . . . em cảm ơn ạ. . .

Góp vui. hãy thử xem.

Mã:

Sub CHUYEN()
Dim Arr(), KQ()
Dim i&, j&, t&, k&, Lr&, Col&
With Sheet1
Lr = .Cells(Rows.Count, 1).End(3).Row
Col = .Cells(2, Columns.Count).End(xlToLeft).Column
Arr = .Range(.Cells(3, 1), .Cells(Lr, Col)).Value
End With
On Error Resume Next
ReDim KQ(1 To UBound(Arr, 2), 1 To UBound(Arr, 1))
 For i = 1 To UBound(Arr, 1)
         t = t + 1
    For j = 1 To UBound(Arr, 2)
            KQ(1, t) = Arr(i, 1)
        For k = 3 To UBound(Arr, 2)
             KQ(k - 1, t) = Arr(i, k)
        Next k
    Next j
Next i
Sheet2.[A5].Resize(1000, 10000).ClearContents
Sheet2.[A5].Resize(UBound(Arr, 2) - 1, t) = KQ

End Sub
[code]

zPeterPan · 22/7/21

Cảm ơn bác @HieuCD và bác @HUONGHCKT
từ code của các bác. em muốn chuyển toàn bộ dữ liệu từ cột của sheet2 sang cột của sheet3 nhưng báo lỗi dòng ReDim res(1 To UBound(sArr, 1), 1 To UBound(sArr, 2)). . . sai chỗ nào vậy ạ. . .

Mã:

Sub Chuyenmang()
  Dim sArr(), res As String, sRow&, sCol&, i&, j&, dong As String, cot As String
   With Sheet2
    dong = .Range("A" & Rows.Count).End(xlUp).Row
    cot = .Cells(1, Columns.Count).End(xlToLeft).Column
    sArr = .Range("A5", .Cells(dong, cot)).Value
  End With
  ReDim res(1 To UBound(sArr, 1), 1 To UBound(sArr, 2))
  For i = 1 To UBound(sArr)
    res(i, j) = sArr(i, j)
    For j = 1 To UBound(sArr, 2)
      res(i, j) = sArr(i, j)
    Next j
  Next i
  With Sheet3
    .Range("A1").Resize(sRow, sCol) = res
  End With
End Sub

HieuCD · 22/7/21

zPeterPan đã viết:
Cảm ơn bác @HieuCD và bác @HUONGHCKT
từ code của các bác. em muốn chuyển toàn bộ dữ liệu từ cột của sheet2 sang cột của sheet3 nhưng báo lỗi dòng ReDim res(1 To UBound(sArr, 1), 1 To UBound(sArr, 2)). . . sai chỗ nào vậy ạ. . .

Mã:

Sub Chuyenmang() Dim sArr(), res As String, sRow&, sCol&, i&, j&, dong As String, cot As String With Sheet2 dong = .Range("A" & Rows.Count).End(xlUp).Row cot = .Cells(1, Columns.Count).End(xlToLeft).Column sArr = .Range("A5", .Cells(dong, cot)).Value End With ReDim res(1 To UBound(sArr, 1), 1 To UBound(sArr, 2)) For i = 1 To UBound(sArr) res(i, j) = sArr(i, j) For j = 1 To UBound(sArr, 2) res(i, j) = sArr(i, j) Next j Next i With Sheet3 .Range("A1").Resize(sRow, sCol) = res End With End Sub

Khai báo "dim res , dong, cot" sai, chỉnh lại
Dim sArr(), res() , sRow&, sCol&, i&, j&, dong&, cot&g

zPeterPan · 22/7/21

HieuCD đã viết:
Khai báo "dim res , dong, cot" sai, chỉnh lại
Dim sArr(), res() , sRow&, sCol&, i&, j&, dong&, cot&g

Tiếp theo là bị lỗi dòng này ạ res(i, j) = sArr(i, j).. . . vòng lặp sai cấu trúc gì ạ. . .

Ba Tê · 22/7/21

zPeterPan đã viết:
em muốn chuyển toàn bộ dữ liệu từ cột của sheet2 sang cột của sheet3

Chuyển toàn bộ là sao? Y chang nhau thì Copy - Paste cho nhanh.

zPeterPan · 22/7/21

Ba Tê đã viết:
Chuyển toàn bộ là sao? Y chang nhau thì Copy - Paste cho nhanh.

vì số lượng dòng và cột không cố định ạ. . . nếu để cụ thể số cột thì lâu lắm ạ và tăng dung lượng file lên hơn 100mb ạ. . . em dùng recre macro và bị tăng dung lượng file nên là em hỏi về mảng để cho dữ liệu vào mảng và chuyển mảng sang sheet khác ạ. . .

Mã:

    With Sheet10
        .Range("D3:BBB200").ClearContents
        Sheet9.Range("A5:BBB200").Copy
        .Range("D3").PasteSpecial

Ba Tê · 22/7/21

zPeterPan đã viết:
vì số lượng dòng và cột không cố định ạ. . . nếu để cụ thể số cột thì lâu lắm ạ và tăng dung lượng file lên hơn 100mb ạ. . . em dùng recre macro và bị tăng dung lượng file nên là em hỏi về mảng để cho dữ liệu vào mảng và chuyển mảng sang sheet khác ạ. . .

Mã:

With Sheet10 .Range("D3:BBB200").ClearContents Sheet9.Range("A5:BBB200").Copy .Range("D3").PasteSpecial

Bạn thử chạy Sub này rồi xem dung lượng thay đổi ra sao so với For - Next luxubu.

PHP:

Sub Chuyenmang()
Dim Rng As Range
With Sheet2
    Set Rng = .Range("A5", .Range("A5").End(xlDown)).Resize(, .Range("A5").End(xlToRight).Column)
End With
    Rng.Copy
    Sheet3.Range("A5").PasteSpecial
    Application.CutCopyMode = False
Set Rng = Nothing
End Sub

Bạn muốn Mảng thì xem cái này:

PHP:

Sub Chuyenmang()
Dim Arr()
    Arr = Sheet2.Range("A5", Sheet2.Range("A5").End(xlDown)).Resize(, Sheet2.Range("A5").End(xlToRight).Column).Value
Sheet3.Cells.ClearContents
Sheet3.Range("A5").Resize(UBound(Arr), UBound(Arr, 2)) = Arr
End Sub

zPeterPan · 25/7/21

Ba Tê đã viết:
Bạn muốn Mảng thì xem cái này:

PHP:

Sub Chuyenmang() Dim Arr() Arr = Sheet2.Range("A5", Sheet2.Range("A5").End(xlDown)).Resize(, Sheet2.Range("A5").End(xlToRight).Column).Value Sheet3.Cells.ClearContents Sheet3.Range("A5").Resize(UBound(Arr), UBound(Arr, 2)) = Arr End Sub

Cảm ơn Thầy @Ba Tê. . . Như tiêu đề của bài viết chuyển từ sheet1 sang sheet 2. . . thì em phải khai báo 2 mảng ạ. . .

Vũ Tuấn Tùng · 20/8/21

Ba Tê đã viết:
Bạn thử chạy Sub này rồi xem dung lượng thay đổi ra sao so với For - Next luxubu.

PHP:

Sub Chuyenmang() Dim Rng As Range With Sheet2 Set Rng = .Range("A5", .Range("A5").End(xlDown)).Resize(, .Range("A5").End(xlToRight).Column) End With Rng.Copy Sheet3.Range("A5").PasteSpecial Application.CutCopyMode = False Set Rng = Nothing End Sub

Bạn muốn Mảng thì xem cái này:

PHP:

Sub Chuyenmang() Dim Arr() Arr = Sheet2.Range("A5", Sheet2.Range("A5").End(xlDown)).Resize(, Sheet2.Range("A5").End(xlToRight).Column).Value Sheet3.Cells.ClearContents Sheet3.Range("A5").Resize(UBound(Arr), UBound(Arr, 2)) = Arr End Sub

Thầy có thể sửa code để lấy dữ liệu khi số lượng dòng của các cột không bằng nhau được không ạ, vì theo code của thầy sẽ lấy số liệu các dòng từ cột 2 đến cột cuối theo dòng cuối cùng của cột 1

Chuyển dữ liệu giữa các sheet từ cột thành hàng và hàng thành cột. . .

zPeterPan

Thành viên hoạt động

Hoàng Tuấn 868

Đăng ký hôm qua

zPeterPan

Thành viên hoạt động

Hoàng Tuấn 868

Đăng ký hôm qua

zPeterPan

Thành viên hoạt động

HieuCD

Chuyên gia GPE

HUONGHCKT

Zalo 0986997214

zPeterPan

Thành viên hoạt động

File đính kèm

HieuCD

Chuyên gia GPE

zPeterPan

Thành viên hoạt động

Ba Tê

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

zPeterPan

Thành viên hoạt động

Ba Tê

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

zPeterPan

Thành viên hoạt động

Vũ Tuấn Tùng

Thành viên mới

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

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng