Mình có 1 bảng dữ liệu, dữ liệu tương đối nhiều. Mình muốn chuyển dữ liệu của các dòng thành cột, có file đính kèm theo, nhờ các anh chị em giúp đỡ. Dùng lệnh copy-paste-transpose thì không thích hợp cho file dữ liệu này. Xin giúp đỡ. Cảm ơn nhiều.
Tờ 24, thửa 22 (các dòng 2379:2382) đang trùng lặp đấy nhé bạn. Nếu dữ liệu chỗ này mà nhập đúng thì cần phải thêm cột LD4 và DT4 nữa mới đủ chứa kết quả.
Bài này mà dùng hàm thì chắc ớn ăn lắm, ít nhất là tôi chịu thua. Thôi thì sẵn lâu ngày không dợt lại em "đít to" (Dictionary), nay luyện lại cho khỏi quên:
[GPECODE=vb]Sub ChuyenDuLieu()
Dim Dic As Object, i As Long, k As Long, n As Long, S As String, Tmp, Arr()
On Error Resume Next
n = Sheet1.[A65500].End(xlUp).Row - 2 'So dong du lieu
[I3

3].Resize(n).Clear 'Xoa vung chua ket qua
Tmp = [A3

3].Resize(n)
ReDim Arr(1 To n, 1 To 8)
Set Dic = CreateObject("Scripting.Dictionary")
For i = 1 To n
S = Tmp(i, 1) & "_" & Tmp(i, 2)
If Not Dic.Exists(S) Then
k = k + 1
Dic.Add S, 1 'Them Key (To_Thua)
Else
Dic.Item(S) = Dic.Item(S) + 1 'Them Item (LD, DT)
End If
Arr(k, 1) = Tmp(i, 1) 'To
Arr(k, 2) = Tmp(i, 2) 'Thua
Arr(k, Dic.Item(S) + 2) = Tmp(i, 3) 'LD
Arr(k, Dic.Item(S) + 5) = Tmp(i, 4) 'DT
Next
Sheet1.[I3

3].Resize(k) = Arr 'Gan du lieu len sheet
End Sub[/GPECODE]
Nếu dữ liệu ở các dòng 2379:2382 bạn nhập sai và xóa bớt đi thì vùng chứa kết quả là đủ cột cần thiết, và bạn xóa dòng lệnh 4 ở trên đi (dòng lệnh On Error Resume Next)
Trong file, bạn nhấn nút Chuyển dữ liệu để chạy code.
Lưu ý: Code chỉ chạy đúng khi dữ liệu gốc đảm bảo rằng các lô đất cùng tờ, thửa được nhập liền nhau.