Sub Main()
Dim tmpArr, Arr()
Dim lR As Long, lC As Long, lCs As Long, i As Long, n As Long, lCPos As Long
Dim wks As Worksheet, wksDes As Worksheet, Dic As Object
Dim sTitle As String
On Error Resume Next
Set Dic = CreateObject("Scripting.Dictionary")
Set wksDes = Worksheets("Tong hop")
wksDes.UsedRange.ClearContents ' Xóa hết dữ liệu trong sheet Tong hop
ReDim Arr(1 To 60000, 1 To 1) ' Khởi tạo mảng Arr có 60000 dòng và một cột
For Each wks In ThisWorkbook.Worksheets ' Duyệt qua tất cả các sheet
If UCase(wks.Name) <> UCase(wksDes.Name) Then ' nếu sheet nào có tên khác "tong hơp" (không phân biệt chữ thường hay hoa) thì
tmpArr = wks.UsedRange.Value ' chuyển sheet đó thành một mảng tmpArr rồi xét tiếp:
If TypeName(tmpArr) = "Variant()" Then ' nếu kiểu dữ liệu của tmpArr đúng là mảng hay nói cách khác nếu mảng tmpArr có nhiều hơn một phần tử thì:
n = n + 1
For lR = 2 To UBound(tmpArr, 1) ' duyệt từ dòng thứ 2 đến dòng cuối cùng của mảng tmpArr; ( (UBound(tmpArr, 1) là kích thước chiều thứ nhất của mảng tmpArr)
n = n + 1
For lC = 1 To UBound(tmpArr, 2) ' trong từng dòng lR, duyệt từ cột thứ nhất đến cột cuối cùng
sTitle = Trim(CStr(tmpArr(1, lC))) ' gọi sTitle là phần tử thuộc hàng thứ nhất, cột đang xét của mảng tmpArr (hàm trim bạn thừa biết, tác giả còn thêm hàm CStr để biến dữ liệu thành chuỗi? - nhờ tác giả giải thích mục đích, nếu là mình sẽ không đặt câu này ở đây)
If Len(sTitle) Then ' nếu sTitle có chứa ký tự (có thể viết If sTitle <> "")
If Not Dic.Exists(sTitle) Then ' nếu sTitle chưa có trong danh sách của Dic thì
lCs = lCs + 1 ' thêm một phần tử vào danh sách của Dic
Dic.Add sTitle, lCs ' phần tử đó chính là sTitle và có Item là lCs
If UBound(Arr, 2) < lCs Then ReDim Preserve Arr(1 To 60000, 1 To lCs) ' nếu số cột (chiều thứ 2) của mảng Arr < lCs thì mở rộng chiều thứ hai của mảng bằng với lCs
Arr(1, lCs) = sTitle ' Gán phần tử ở dòng thứ nhất, cột thứ lCs của mảng Arrthành sTitle (tiêu đề)
Arr(n, lCs) = tmpArr(lR, lC) ' Gán phần tử ở dòng thứ n, cột thứ lCs của mảng Arr bằng phần tử đang xét của mảng tmpArr (chứa dữ liệu của sheet đang xét)
Else ' nếu sTitle đã có trong danh sách của Dic thì
lCPos = Dic.Item(sTitle) ' lấy Item của sTitle trong Dic (xem nó đã nằm ở cột nào trong mảng Arr)
Arr(n, lCPos) = tmpArr(lR, lC) ' Gán phần tử ở dòng thứ n, cột thứ lCPos của mảng Arr bằng phần tử đang xét của mảng tmpArr
End If
End If
Next lC
Next lR
End If
End If
Next wks
If n * lCs Then ' nếu tổng số dòng (không tính tiêu đề) và tổng số cột của mảng Arr đều >=1
With wksDes.Range("A3").Resize(n, lCs)
.Value = Arr ' gán mảng Arr xuống range
.Sort .Rows(1), 1, , , , , , xlYes, , , xlLeftToRight ' sắp xếp theo abc thứ tự cột
End With
End If
End Sub
