Bài viết: Phương thức SpecialCells trong Excel VBA (P2) (2 người xem)

[levanduyet]

3. Phương thức SpecialCells & vùng được gán tên

Macro dưới đây sẽ tự động gán tên lên các trang tính hiện diện tại vùng bắt đầu từ ‘B3’. Còn kết thúc tại điểm giao nhau giữa dòng cuối nhất & cột cuối nhất của trang tính. (Cũng cần nhắc lại rằng, ô giao nhau giữa dòng cuối nhất & cột cuối nhất này không lúc nào trùng hợp với ô cuối nhất chứa dữ liệu)

Sub LastColAndRow()
    Dim lRow As Integer, lCol As Integer
    Dim wSh As Worksheet
    Dim AddressName As String
 For Each wSh In Worksheets
   lRow = wSh.Cells.SpecialCells(xlCellTypeLastCell).Row
   lCol = wSh.Cells.SpecialCells(xlCellTypeLastCell).Column
   AddressName = "=" & Range("B3:" & Cells(lRow, lCol).Address).Address
   ThisWorkbook.Names.Add "GPE" & wSh.Name, AddressName   
 Next wSh
End Sub

4. Các phương thức SpecialCells & AdvancedFilter

Ta hãy xét đến macro Filter2() có nội dung như dưới đây:

Sub Filter2()
    Dim RngFilter As Range, RngFiltered As Range
    Dim StrC As String
    Set RngFilter = Range("G1:G" & Range("G65432").End(xlUp).Row)
    With RngFilter
        .AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=RngFilter, Unique:=True
        Set RngFiltered = RngFilter.SpecialCells(xlCellTypeVisible)
    End With
    RngFiltered.SpecialCells(xlCellTypeVisible).Copy
    Range("I5").PasteSpecial Transpose:=True
    For Each RngFilter In RngFiltered
      StrC = StrC & RngFilter & ", "
    Next RngFilter
    [I7] = StrC
    ActiveSheet.ShowAllData
End Sub

Hai dòng lệnh đầu dùng để khai báo 3 biến, trong đó chỉ 1 biến dùng chứa chuỗi.

Tiếp sau, ta gán vùng "G1:G8" (8 : dòng cuối tại cột ‘G’ có chứa dữ liệu) vô biến có tên là RngFilter
Câu lệnh từ dòng 4 đến dòng 7 dùng để xét đến vùng ‘G1:G8’ này
Áp dụng phương thức AdvFilter lên vùng này để lập danh sách duy nhất vế nó.

Câu lệnh 6: Vùng kết quả do phương thức AdvFilter đem lại, ta đem gán vô biến kiểu Range thứ hai đã khai báo tại dòng 1 (RngFitered)

Dòng lệnh 8: áp đặt phương thức Copy lên biến vừa nói tới;

Dòng 9: Chép chuyển vị từ bộ nhớ (do phương thức Copy) vô các ô trên hàng 5, bắt đầu từ cột ‘I’;

Dòng 10 - 12: Tạo vòng lặp để chép nối giá trị trong các ô chứa trong biến RngFiltered vô biến kiểu chuỗi StrC; Các giá trị cách nhau bỡi dấu phãy & khoảng trắng;

Câu lệnh áp chót: Hiễn thị vùng dữ liệu. Rất nên thức hiện câu lệnh này, một khi trước đó đã dùng phương thức Filter.

5. Phương thức SpecialCells & AutoFilter
Để thấy rõ hơn cách thức làm việc của phương thức SpecialCells với vùng lọc bằng AutoFilter, chúng ta khảo sát macro làm việc với CSDL trong hình 6A dưới đây:

Sub CopyIsFilter()
    Dim Rng As Range
    With Sheet2
        If Not .FilterMode Then
            MsgBox "AutoFilter?": Exit Sub
        End If
        Set Rng = .AutoFilter.Range.Offset(1, 0).Resize(.AutoFilter.Range.Rows. _
                   Count - 1).SpecialCells(xlCellTypeVisible)
         'set a range = to visible cells (excluding the header)
        Rng.Copy Destination:=Sheet4.Range("A1")
    End With
End Sub

Trong khi chúng ta chưa chuẩn bị điều kiện tối thiểu cho macro nhưng cho ‘chạy’ nó, ta sẽ nhận được thông báo lỗi (xem hộp thoại báo lỗi trong hình).
Lỗi này, như trong đoạn mã trên đã ghi, là ta chưa áp đặt FilterMod lên CSDL.
Muốn có kết quả làm việc của macro, ta vô menu Data trong excel, chọn dòng AutoFilter. Hơn thế nữa, ta còn phải bấm vô hình tam giác nào đó vừa xuất hiện (Ví dụ: [SBD], và chọn dòng có ghi ‘(Top10. . . .)’. Như vậy tại Shee2 chỉ hiện lên 10 học sinh có số báo danh lớn nhất.

Bây giờ thí chúng ta có thể yên tâm & cho macro khởi động. Khi chuyển chọn đến Sheet4, ta sẽ thấy kết quả như hình 6B đưới đây. Đó là liệt kê danh sách các em học sinh có số bao danh lớn nhất trong CSDL

Sau đây xin giới thiệu với các bạn đọc 1 macro tương tự để các bạn tham khảo:

Sub CopyFilterRows()
 On Error Resume Next 
    Dim wsData As Worksheet, wsReport As Worksheet
    Dim rFiltered As Range, rNextCl As Range
    On Error GoTo CopyFilterRows_Error
    Set wsData = Worksheets("Sheet2")
    Set wsReport = Worksheets("Sheet4")
    With wsData.AutoFilter.Range
         'Bỏ chọn dòng tiêu đề:
        Set rFiltered = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
        .SpecialCells(xlCellTypeVisible)
         'Chọn ô rỗng dòng cuối của cột ‘A’ của Sheet4 
        Set rNextCl = wsReport.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
         'copy từ Sheet2 đến Sheet4
        rFiltered.Copy rNextCl
        On Error GoTo 0
    End With
    wsData.Select                '.ShowAllData
    Selection.AutoFilter
     'Xóa biến để thu hồi bộ nhớ
    Set wsData = Nothing:              Set wsReport = Nothing
    Set rFiltered = Nothing:           Set rNextCl = Nothing
    On Error GoTo 0
    Exit Sub
CopyFilterRows_Error:     
     MsgBox "Error " & Err.Number & " (" & Err.Description & _
      ") in procedure CopyFilterRows of Module Module1"
End Sub

6. Xóa trùng từ vùng chọn bất kỳ

Chúng ta khảo sát macro dùng để xóa dữ liệu ở các ô trùng trong một vùng đã chọn từ trước đó. Để tiết kiệm tài nguyên xã hội, chúng ta sẽ viết macro sao cho ứng dụng được hình 6B làm nguồn CSDL (cơ sở dữ liệu) & kết quả hiển thị trên hình 6C như dưới đây
Macro có nội dung sau:

Sub KillDupes()
Dim rConstRange As Range, rFormRange As Range
Dim rAllRange As Range, rCell As Range
Dim iCount As Long:        Dim strAdd As String
 On Error Resume Next
Set rAllRange = Selection
If WorksheetFunction.CountA(rAllRange) < 2 Then
MsgBox "You selection is not valid", vbInformation
          On Error GoTo 0: Exit Sub
End If
Set rConstRange = rAllRange.SpecialCells(xlCellTypeConstants)
Set rFormRange = rAllRange.SpecialCells(xlCellTypeFormulas)
 If Not rConstRange Is Nothing And Not rFormRange Is Nothing Then
Set rAllRange = Union(rConstRange, rFormRange)
  ElseIf Not rConstRange Is Nothing Then
    Set rAllRange = rConstRange
  ElseIf Not rFormRange Is Nothing Then
    Set rAllRange = rFormRange
  Else
    MsgBox "You selection is not valid", vbInformation
    On Error GoTo 0:    Exit Sub
  End If   
 Application.Calculation = xlCalculationManual
 For Each rCell In rAllRange
strAdd = rCell.Address
    strAdd = rAllRange.Find(What:=rCell, After:=rCell, LookIn:=xlValues, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _            
                MatchCase:=False).Address          
    If strAdd <> rCell.Address Then  rCell.Clear
  Next rCell
  Application.Calculation = xlCalculationAutomatic
 On Error GoTo 0
End Sub

Các câu lệnh kể từ dòng 21 trở vế trước chúng ta đã gặp, các bạn nếu cần có thể xem lại tại ví dụ 4. Tại đó có giải thích tương đối đầy đủ công việc mà chúng phải thực thi.

Tiếp sau đây, chúng ta xét tiếp các câu lệnh sau dòng 21 nêu trên.

Câu lệnh 22 dùng để tăng tốc chương trình, bỏ qua những phép tự động tính toán lại không cần thiết;
Tạo vòng lặp từ dòng 22 đến dòng 26
(Chú ý nét gạch dưới ở cuối dòng lệnh; chúng báo cho VBA biết là dòng lệnh còn tiếp ngay dòng bên dưới; Khi đó chẳng những máy, mà ta cũng nên biết rằng dòng sau dòng có dấu nối như vậy sẽ không được tính là dòng lệnh nữa.
* Cũng chú ý thêm một điều rằng sau dấu gạch nối dòng lệnh này, ta nhất thiết không được để dòng trống. Những ai có thói quen bỏ 1 hay 1 vài dòng trống cho chương trình dễ nhìn & cũng như dễ kiểm soát thì đây phải là 1 chú ý đáng có. Tất nhiên ta không thức hiện thì VBA cũng sẽ nhắc ta liền)
Ta trở lại các dòng lệnh trong vòng lặp:
D24: Địa chỉ ô hiện hành (trong vòng lặp) được đem gán vô biến chứa chuỗi
D25: dài & là trái tim của macro này. Nó được giải nghĩa như sau:
Hãy tìm giá trị trong ô hiện thời (thuộc vòng lặp); bắt đầu từ sau ô tìm thấy lần tìm trước;
Tìm theo dạng gì?: dạng dữ liệu (không phải công thức); (. . . mấy tham số sau của phương thức này, các bạn tư tìm hiểu lấy trong phần trợ giúp của VBE, khi có dịp rảnh rỗi);
Nếu tìm thấy thì địa chỉ ô tìm thấy đem gán thay thế vô biến (gán thay vì trước đó biến này đã được gán địa chỉ khác tại dòng 24)
D26: xóa dữ liệu trong ô, nếu thỏa điều kiện
D28: trả về trạng thái tính toán mặc định của VBE (tránh làm phiền ngưới khác hay macro cùng sử dụng excel & VBE tiếp sau đó)
Dòng áp chót: tạo thói quen khử lỗi, tạo thuận tiện cho mình & mọi người dùng tiếp sau.
Kết quả macro được thể hiện trên hình 6C
Tại cột ‘D’ ta thấy 1 ô trống; Thực ra tác giả muốn các bạn biết thêm rằng, macro xóa được những ô chứa dữ liệu số lẫn dữ liệu kiểu chuỗi, nên mới chọn hai cột cho macro làm việc. Hơn nữa record cuối trong trang tính là cố tình đưa vô đễ chúng ta cùng dễ quan sát & rút kết luận.
Khi xem kết quả, các bạn chịu khó đối chiếu với hính trước nó. Có vậy, các bạn sẽ ngẫm ra, tại sao các ô trong cột ‘E’ bị xóa đi.

7. Tô màu các ô chứa công thức hàm mảng

Để thấy rõ hơn tác dụng của công việc tô màu, chúng ta sẽ xây dựng một hàm mảng tự tạo. (Tất nhiên chúng ta muốn đưa ra thông điệp rằng, một khi đã tô được màu các ô này thì các ô chứa công thức hàm mảng của excel sẽ là chuyện nhỏ xíu).

Điều trước tiên ta sẽ xây 1 hàm mảng tự tạo giải phương trình bậc hai, như sau:

Option Explicit
Option Base 1
Function PTB2( aA As Double, Bb As Double, cC As Double)
 ReDim temp( 3, 1):         Dim Delta As Double
 Delta = Bb * Bb - 4 * aA * cC
 Select Case Delta
 Case Is < 0
   temp(1, 1) = "Vo Nghem!"
 Case 0
   temp(1, 1) = "Phuong Trinh Co Nghiem duy nhat:"
   temp(2, 1) = -Bb / (2 * aA)
 Case Is > 0
   temp(1, 1) = "Phuong Trinh Co 2 nghiem:"
   temp(2, 1) = (-Bb + Delta ^ (1 / 2)) / (2 * aA)
   temp(3, 1) = (-Bb - Delta ^ (1 / 2)) / (2 * aA)
 End Select
 PTB2 = temp
End Function

Trong hình 7 các ô ‘E1:E3’ đều có chung công thức như trích đưa ra trong khung chữ nhật. Hơn nữa chúng đang hiển thị kết quả nghiệm của phương trình bậc hai với các hệ số của phương trình ghi tương ứng ở hàng 4 (tô màu nền xanh nhạt). nghiệm thứ nhất ghi tại [e2] & nghiệm thứ hai ghi tại [E3].

Cần lưu ý một điều không thừa là, vì là hàm mảng, nên nó cũng đòi được ứng xử như các hàm mảng trong excel dựng sẵn: kết thúc bằng tổ hợp 3 phím {CTRL}+{ATL}+{ENTER}.

Phần chủ yếu, mà chúng ta quan tâm là macro tô màu cho 3 ô chứa công thức hàm mảng này. Nó có nội dung như sau:

Sub Highlight_Arrays()
    Dim Clls As Range
    For Each Clls In Cells.SpecialCells(xlFormulas)
        If Clls.HasArray Then cell.Interior.ColorIndex = 36
    Next Clls
End Sub

Thật không có gì phức tạp trong macro này cho lắm. trong vòng lặp chỉ có 1 câu lệnh. Câu lệnh đó là: nếu ô chứa mảng, thì tô màu vàng nhạt cho nó. Nhưng trước đó ta biết rằng, những ô được duyệt chỉ là những ô có công thức trên trang tính mà thôi.
Theo như trong hình, chúng ta có 11 ô chứa công thức. ngoài 3 ô đã liệt kê, chúng ta còn thêm 8 ô tại cột ‘A’ cũng chứa công thức, nhưng không phải là công thức mảng. các bạn nên tin điều đó là thật, một khi nhìn lên thanh công thức trên hình. Nó đang biểu thị công thức trong ô ‘A9’ đang được kích hoạt.

Một số bài viết có liên quan:
1/ Phương thức SpecialCells trong Excel VBA (P1)
2/ [Gỡ rối VBA] Lỗi vòng lặp lặp vô tận - Lỗi từ vòng lặp
3/ Hàm để lấy chỉ số màu trong các ô đã Conditional Formatting
4/ Xếp một trường theo một trật tự màu quy định trước
5/ Sử dụng Name trong VBA
6/ Viết code để nhìn thấy ai là người cập nhật bảng tính của bạn lần gần đây nhất
7/ 3 gợi ý nhỏ mang lại thành công trong khai báo biến trong VBA
8/ Tổng quan về Scripting.Dictionary
9/ Khi nào nên sử dụng Msgbox, Inputbox và Userform?
10/ Làm thế nào để thay thế các chữ OK, CANCEL,... nhàm chán của Msgbox
http://www.giaiphapexcel.com/vbb/content.php?565