Chào mọi người,
Mình có một file Excel với rất nhiều cột, và đôi khi sếp yêu cầu sắp xếp lại thứ tự các cột theo một trật tự khác. Làm thủ công thì rất mất thời gian, đặc biệt với những file có hàng trăm cột. Hôm nay, mình muốn chia sẻ một đoạn code VBA nhỏ giúp tự động hóa việc này.
Giả sử bạn muốn sắp xếp lại các cột dựa trên một danh sách tên cột mong muốn trong một Sheet khác hoặc một mảng cố định. Code dưới đây sẽ thực hiện điều đó.
Sub SapXepCotTheoThuTu()
Dim wsData As Worksheet
Dim wsOrder As Worksheet
Dim rngData As Range
Dim arrOrder() As Variant
Dim i As Long, j As Long
Dim found As Boolean
Dim targetColumn As Range
' --- Cấu hình ---
Set wsData = ThisWorkbook.Sheets("Sheet1") ' Sheet chứa dữ liệu cần sắp xếp cột
' Danh sách tên cột mong muốn (có thể lấy từ 1 Sheet khác)
Set wsOrder = ThisWorkbook.Sheets("OrderSheet")
Dim lastRowOrder As Long
lastRowOrder = wsOrder.Cells(wsOrder.Rows.Count, "A").End(xlUp).Row
arrOrder = wsOrder.Range("A1:A" & lastRowOrder).Value
' --- Kết thúc cấu hình ---
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
' Tìm phạm vi dữ liệu
Set rngData = wsData.UsedRange
' Tạo một mảng tạm để lưu trữ các cột theo thứ tự mới
Dim tempArray() As Variant
ReDim tempArray(1 To rngData.Rows.Count, 1 To UBound(arrOrder, 1))
' Duyệt qua danh sách thứ tự mong muốn
For j = 1 To UBound(arrOrder, 1)
found = False
' Tìm cột tương ứng trong dữ liệu gốc
For i = 1 To rngData.Columns.Count
If wsData.Cells(1, i).Value = arrOrder(j, 1) Then ' So sánh với hàng tiêu đề
' Copy toàn bộ cột vào mảng tạm
Set targetColumn = rngData.Columns(i)
Dim k As Long
For k = 1 To rngData.Rows.Count
tempArray(k, j) = targetColumn.Cells(k, 1).Value
Next k
found = True
Exit For
End If
Next i
' Nếu không tìm thấy cột trong dữ liệu gốc, có thể xử lý thêm (ví dụ: bỏ trống)
If Not found Then
MsgBox "Cột '" & arrOrder(j, 1) & "' không tìm thấy trong dữ liệu!", vbExclamation
End If
Next j
' Xóa các cột cũ và ghi dữ liệu từ mảng tạm
wsData.Cells.ClearContents ' Xóa toàn bộ nội dung cũ
wsData.Range("A1").Resize(UBound(tempArray, 1), UBound(tempArray, 2)).Value = tempArray
Application.ScreenUpdating = True
MsgBox "Đã sắp xếp lại thứ tự các cột thành công!", vbInformation
Exit Sub
ErrorHandler:
Application.ScreenUpdating = True
MsgBox "Đã xảy ra lỗi: " & Err.Description, vbCritical
End Sub
Lưu ý:
- Bạn cần tạo một sheet mới (ví dụ:
OrderSheet) và liệt kê tên các cột bạn muốn theo đúng thứ tự mong muốn ở cột A. - Code này giả định rằng tên cột nằm ở hàng đầu tiên (hàng 1) của
Sheet1. - Nếu có cột trong danh sách thứ tự không tồn tại trong dữ liệu gốc, code sẽ báo lỗi.
Hy vọng mẹo nhỏ này hữu ích cho các bạn khi làm việc với Excel!