Thuộc tính UsedRange trả về vùng đã sử dụng của Sheet, rất hữu dụng khi cần duyệt qua tất cả dòng dữ liệu hiện có trên một Sheet (không cần biết hiện có bao nhiêu dòng trên Sheet, kể cả dòng trắng xen kẻ), bằng vòng lặp xác định như sau :
Dim dong As Object
For Each dong In Sheet1.UsedRange
Msgbox "Code xử lý dòng thứ :" & dong.row
Next dong
Option Explicit
Sub DuyetCot()
Dim lRow As Long, iJ As Long, iZ As Byte
2 lRow = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For iZ = 0 To 255
4 If Cells(lRow, iZ + 1) <> "" Then Exit For
Next iZ
For iJ = 1 To lRow
6 MsgBox Cells(iJ, iZ + 1), , "Dong:" & Str(iJ)
Next iJ
End Sub
Dòng lệnh 2: Tìm đến dòng cuối cùng chứa dữ liệu;
Các dòng lệnh trong vòng lặp (4): Tìm cột tại dòng cuối dữ liệu;
Các dòng lệnh trong vòng lặp (6): Duyệt theo cột này
Option Explicit
Sub DuyetCot()
Dim lRow As Long, iJ As Long, iZ As Byte
2 lRow = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For iZ = 0 To 255
4 If Cells(lRow, iZ + 1) <> "" Then Exit For
Next iZ
For iJ = 1 To lRow
6 MsgBox Cells(iJ, iZ + 1), , "Dong:" & Str(iJ)
Next iJ
End Sub
Dòng lệnh 2: Tìm đến dòng cuối cùng chứa dữ liệu;
Các dòng lệnh trong vòng lặp (4): Tìm cột tại dòng cuối dữ liệu;
Các dòng lệnh trong vòng lặp (6): Duyệt theo cột này
2./ Vùng giao nhau với các cột cho trước & đặt tên 1 vùng dữ liệu
Ta khảo sát tiếp macro sau:
Mã:
Sub UsedRange()
Dim lRow As Long, bCol As Byte
2 lRow = Worksheets("S1").UsedRange.Rows.Count
3 bCol = Worksheets("S1").UsedRange.Columns.Count
With ActiveSheet
5 MsgBox Intersect(.Range("c:q"), .UsedRange).Address
End With
7 ThisWorkbook.Names.Add "Matrix", "=!r2c2:r" & lRow & "c" & bCol
'expression.Add(Name, RefersTo, Visible, MacroType, ShortcutKey, Category, NameLocal, _
RefersToLocal, CategoryLocal, RefersToR1C1, RefersToR1C1Local)
End Sub
Dòng lệnh 2 được hiểu là số dòng chứa dữ liệu của Sheets(“S1”) đem gán vô biến lRow
Tương tự dòng lệnh 3: biến bCol sẽ chứa số cột có dữ liệu;
Dòng 5 cho ta biết địa chỉ giao nhau giữa vùng chứa dữ liệu & các cột từ ‘C’ đến ‘Q’;
Dòng 7 các ô từ dòng 2, cột 2 đến ô cuối phải nhất được gán tên là ‘Matrix’
3./ Duyệt các ô trong 1 hàng & trong tất cả các cột của vùng chứa dữ liệu
PHP:
Sub OutputAddress()
Dim myRange As Range, rRng As Range, cRng As Range
Dim intUnit As Integer
Dim StrR As String, StrC As String, Xh As String
Xh = Chr(10) & Chr(13)
Set myRange = ActiveSheet.UsedRange
For Each rRng In myRange.Rows
StrR = StrR & rRng.Address & Xh
For Each cRng In rRng.Cells
StrC = StrC & rRng.Address
Next
Next
MsgBox StrR, , "Row"
End Sub
4./ Nhân toàn bộ các ô chứa công thức số với 1 giá trị
PHP:
Sub NegativeAllNumberFormula2()
On Error Resume Next
With Range("IV65536")
.Value = -1
.Copy
ActiveSheet.UsedRange.SpecialCells _
(xlCellTypeFormulas, xlNumbers).PasteSpecial _
xlPasteValues, xlPasteSpecialOperationMultiply
.Clear
End With
End Sub
5./ Xóa dòng theo điều kiện của 1 cột (‘D’) chứa ô trống
PHP:
Sub DeleteRowsWithSpecifiedData()
'Looks in Column D and requires Column IV to be clean
Columns(4).EntireColumn.Insert
With Range("D1:D" & ActiveSheet.UsedRange.Rows.Count)
.FormulaR1C1 = "=IF(RC[1]="""",NA(),IF(RC[1]=""Not Needed"",NA()))"
.Value = .Value
On Error Resume Next
.SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
End With
On Error GoTo 0
Columns(4).EntireColumn.Delete
End Sub
6./ Phóng đại vùng chứa dữ liệu khi sheet được kích hoạt
PHP:
Private Sub Worksheet_Activate()
Application.EnableEvents = True
Application.WindowState = xlMaximized
ActiveSheet.UsedRange.Select
ActiveWindow.Zoom = True
End Sub
7./ Lập danh sách địa chỉ vùng chứa dữ liệu
PHP:
Private Sub Workbook_BeforeSave _
(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Put in the UsedRange Address of Sheet1 Book1.xls (this workbook)
Sheet2.Cells(Cells(65432).End(xlUp).Row + 1, 1) = Sheet1.UsedRange.Address
End Sub
Giả dụ chúng ta có trang tính ‘S1’ đang được kích hoạt, Tại cột A, từ A1 đến A9 & B1 đến B9 có dữ liệu đã nhập, ta thêm vài giá trị vô ô i14 & i15;
Khi đó ta chạy macro ( Mc)
PHP:
Sub UsedRange()
Dim rTable As Range
Set rTable = Sheet1.UsedRange
MsgBox rTable.Address, , "0"
End Sub
Trong hộp thoại sẽ là $A$1:$I$15; Còn khi chạy Mc có nội dung
PHP:
Sub CurrentRegion1()
Dim rTable As Range
Set rTable = Sheet1.Range("A1").CurrentRegion
MsgBox rTable.Address, , "1"
Set rTable = Sheet1.Range("i13").CurrentRegion
MsgBox rTable.Address, , "2"
With Sheet1
Set rTable = .Range(.Range("c2"), _
.Cells(65536, .Range("IV1").End(xlToLeft).Column).End(xlUp))
End With
MsgBox rTable.Address, , "3"
End Sub
Sẽ xuất hiện lần lược 3 hộp thoại sau
1: $A$1:$B$9
2: $I$13:$I$15
3: $B$2:$C$9
Như vậy 3 hộp thoại cuối đưa ra 3 địa chỉ hoàn toàn khác so với vùng sử dụng (do Mc đầu tiên đưa ra). Những địa chỉ này hoàn toàn tùy thuộc vào vị trí ta đang đứng & bắt đầu gọi thực hiện CurrentRegion.
2./ Điều kì diệu của CurrentRegion
Tiếp đến ta xét đến một điều kì diệu & vô cùng thông minh của excel. Để vậy, chúng ta nhập tiếp các tên người vô cột E, bắt đầu từ E2 đến E9; Còn từ F2 đến F9 là những con số bất kỳ;
Sau đó ta cho chạy Mc sau:
PHP:
Sub TableWithHeaders()
Dim rTable As Range: Dim lHeaderRow As Long
Set rTable = Sheet1.Range("E1").CurrentRegion
lHeaderRow = rTable.ListHeaderRows
MsgBox rTable.Address, , "A"
If lHeaderRow > 0 Then
Set rTable = rTable.Resize(rTable.Rows.Count - lHeaderRow)
MsgBox rTable.Address, , "B"
Set rTable = rTable.Offset(1)
MsgBox rTable.Address, , "C"
End If
End Sub
Nếu thực hiện đúng các thao tác như đã nêu, các bạn chỉ nhận được 1 hộp thoại duy nhất mang ký hiệu ‘A’, với nội dung như sau: $E$1:$F$9 (Giống trường hợp hộp thoại số (2) như trên);
Tiếp theo ta sửa nội dung của ô F2 thành chuỗi: ‘SoTien’
Lần chạy lại Mc kỳ này, ta thu thêm 2 hộp thoại mới
(B): $E$1:$F$7
(C): $E$2:$F$8
Ở đây trường hợp (C) dùng phương thức OFFSET() của một vùng nên vùng mới tăng so với vùng trước nó (chưa dùng phương thức OFFSET()) một dòng
Các vấn đề còn lại, các bạn ngẫn nghĩ & tự rút ra kết luận cho chính mình;
What Constitutes a Heading/Header Row
If your table is numeric data and you headings are text (or vice verca), Excel will assume row 1 of the table as a header row. However, if your data AND headings are both numeric, or both text, Excel will consider your table as having NO headers. The way to overcome this is to make your headings different to that of the data. This can be done via bolding, font color/size etc.
Or, should you simply know for a fact that row 1 of the table IS a header row you can use the code below; (Các bạn thông cảm cho vốn tiếng anh bé tẹo của mỉnh & tự đọc lấy nha!)
3./ Truy xuất từng cột dữ liệu trong vùng CurrentRegion
Để làm rõ hơn vấn đề truy xuất dữ liệu của 1 cột nào đó, chúng ta xét tiếp 1 Mc nữa, sau đây:
PHP:
Sub LoopColsSheet()
Const Cot = 2
Dim wSh As Worksheet: Dim Rng As Range
For Each wSh In Worksheets
Select Case UCase(wSh.Name)
Case "S2", "S1"
'Do nothing
Case Else
For Each Rng In wSh.Range("A5").CurrentRegion.Columns(Cot).Cells
MsgBox Rng , , “4”
Next Rng
End Select
Next wSh
End Sub
Nếu ta cho Mc chạy, ta sẽ thu được thông tin dữ liệu cùa cột 2
Nếu ta thay Cot = 9, & cho chạy lại Mc, ta vẫn thu được từng ấy hộp thoại 4 mà thôi.
4./ Biến chứa vùng CurrentRegion
Tương tự như vậy, ta xét thêm trường hợp sau
PHP:
Sub Matric()
Dim Mang, iJ As Long
Mang = Sheets("S1").Range("a1").CurrentRegion.Resize(, 3).Value
For iJ = 1 To UBound(Mang, 1)
MsgBox Mang(iJ, 2), , "5"
Next iJ
Exit Sub: End Sub
Trong Mc có 2 giá trị là 3 & 2; Ta chạy thử nhiều lần với các giá trị này tăng dần xem sao. Mình ngờ rằng kết quả sẽ như Mc trên nó!
5./ CurrentRegion & copy các cột dữ liệu
Ví dụ ta có dữ liệu của năm trước tại cột A:C Bắt đầu từ cột E cách đều 4 cột là dữ liệu của các tháng trong năm hiện thời; (Mỗi tháng gồm 3 cột dữ liệu & cách tháng sau nó 1 cột trống)
Nhiệm vụ đề ra là chép 12 tháng dữ liệu vô ba cột lưu dữ liệu năm trước (tại cột A:C)
Nhiệm vụ này chúng ta giao cho Mc sau:
PHP:
Sub Copy3Columns()
Dim Rng As Range: Dim lRow As Long
Set Rng = Range("E1")
lRow = Range("A" & Rows.Count).End(xlUp).Row + 1
While Rng.Value <> ""
Rng.CurrentRegion.Copy Range("A" & lRow)
lRow = lRow + Rng.CurrentRegion.Rows.Count
Rng.Resize(, 4).EntireColumn.Delete
Set Rng = Range("E1")
Wend
Set Rng = Nothing
End Sub
Mc Copy3Columns có dòng lệnh 1: khai báo hai biến sẽ dùng;
D2: Ta chọn & kích hoạt ô ‘E1’
D3 : thêm 1 vô giá trị dòng cuối của dữ liệu lưu gán vô biến lRow đã khai báo ;
D4 & D9 : Thiết lập vòng lặp cho đến khi thỏa điều kiện giá trị chứa trong biến Rng là trống ;
D5 : Vùng dữ liệu lưu được chép thêm từ vùng CurrentRegion ;
D6 : Xác định lại dòng cuối của dữ liệu lưu (đã + 1)
D7 : Xóa 4 cột vừa chép ;
D8 : Xác lập lại vùng chọn
