Các tài liệu hướng dẫn

[levanduyet]

Mục lục:
1. Phương thức SpecialCells trong Excel VBA
2. Highlight hàng khi di chuyển chuột - Highlight row when moving the mouse
3. Dùng Macro 4 để tạo menu



1. Phương thức SpecialCells trong Excel VBA

Tác giả: SA_DQ
Tham khảo tại đây.

Một trong những phương thức có ích nhất (theo kinh nghiệm bản thân) trong Excel là phương thức SpecialCells.
Trong Excel bạn hãy gõ Ctrl + G (hoặc F5) bạn sẽ thấy hộp thoại Go To sau:

Sau đó bạn tiếp tục nhấn nút Special... bạn sẽ được hộp thoại sau:

Hộp thoại này giúp bạn một số thao tác rất hữu ích như: tìm ô cuối cùng trong worksheet, hoặc tất cả các ô là số mà thôi,…hầu hết các thao tác này bạn đều có thể thực hiện bằng VBA, đó chính là việc dùng phương thức SpecialCells.
Khi được gọi, phương thức SpecialCells sẽ trả về một Đối tượng Range đặc trưng cho kiểu của những ô ta chỉ định. Ví dụ: ta có thể dùng phương thức SpecialCells để trả về một đối tượng Range chỉ chứa công thức. Và nếu muốn ta có thể giới hạn để đối tượng Range (chỉ chứa công thức) trả về công thức có lỗi (Tương ứng với hộp thoại Go To Special > Formulas > Errors).

Cú pháp của phương thức SpecialCells là:

expression.SpecialCells(Type, Value)

Trong đó expression là một biến đại diện cho một đối tượng Range.
Type: Kiểu dữ liệu là XlCellType.
XlCellType có thể là một trong những hằng số sau:

Chú ý: Không thể dùng kết hợp nhiều hơn một kiểu XlCellType cho tham số này.

Value: đối số này không bắt buộc, có kiểu là variant. Nếu Type có giá trị là xlCellTypeConstants hoặc xlCellTypeFormulas thì đối số này được dùng để xác định kiểu nào của các ô được trả về.
Các hằng của XlSpecialCellsValue, được thể hiện trong bảng sau:

Ví dụ sau sẽ chọn ô cuối cùng trong vùng đã được dùng trong Sheet1:

Worksheets("Sheet1").Activate
ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Activate

Có thể kết hợp nhiều từ khóa XlSpecialCellsValue với nhau cho tham số này.
Phương thức SpecialCells có thể được sử dụng trong rất nhiều tình huống, khi ta chỉ cần thao tác với một kiểu dữ liệu đặc trưng của các ô trong vùng.
Ví dụ: câu lệnh dưới sẽ trả về một vùng đối tượng (Range) chỉ chứa đặc trưng là loại công thức trong trang tính hiện hành.

ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas)

Nếu muốn, ta có thể giới hạn để phương thức trả về đối tượng Range mang đặc trưng là các công thức trả về của chúng chỉ là giá trị số.

ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas,xlNumbers)

Một khi ta đã chỉ định kiểu của đối tượng Range trả về, ta có thể thao tác với chỉ những ô đó. Điều này thường có thể được thực hiện chỉ bằng một dòng lệnh, hoặc ta thực hiện một vòng lặp Loop cho Range. Mời xem các ví dụ dưới đây để hiểu rõ hơn về phương thức này:

Ví dụ 1

Sub SpeacialCells0()
    ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas). _
      	Interior.ColorIndex = 35
End Sub

Vậy là macro chỉ gồm 1 câu lệnh đã tô màu cho cột chứa số thứ tự của hồ sơ, nơi mà ai đó đã nhập vô công thức tại A2 như sau:

 =IF(A1 = “TT”; 1; A1 + 1)

và công thức này đã được chép xuống đến ô 16. Như trong hình dẫn ra công thức tại ô ‘A13’.
Cần nói thêm rằng thuộc tính UsedRange mà trong câu lệnh có đề cập đến, chúng ta sẽ hay đã gặp trong Ebook này. Nếu chúng ta chưa gặp, thì sẽ được gặp & hiểu kỹ về nó sau, còn bây giờ ta tạm hiểu, thuộc tính sẽ trả về toàn bộ các ô mà ta đã dùng trên trang tính.

Ví dụ 2

Sub SpeacialCells1()
 Dim rRng As Range, rClls As Range
 Set rRng = ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas, xlNumbers)
 For Each rClls In rRng
  	 rClls = -1 * rClls.Value
 Next rClls
End Sub

Trong macro thứ hai ta đã dùng một vòng lặp để mọi giá trị số trên trang tính được chuyển trả về số đối âm của chúng.
Ta có thể dùng phương thức PasteSpecial để thực hiện điều này mà không cần dùng vòng lặp, khi đó các công thức được giữ nguyên trong các ô của chúng. Macro để thực hiện việc như vậy có nội dung như sau:

Sub SpeacialCells_()
  With Range("IV65536")
       .Value = -1:	 .Copy
            ActiveSheet.UsedRange.SpecialCells _
                (xlCellTypeFormulas, xlNumbers).PasteSpecial _
                xlPasteValues, xlPasteSpecialOperationMultiply
        .Clear
   End With
End Sub

Nếu quen thuộc với Excel và những tính năng của nó, như SpecialCells, ta sẽ biết khi ta chỉ định chỉ một ô (bằng Selection hay Range) Excel sẽ cho rằng ta muốn thao tác với toàn bộ các ô của trang tính.

Ví dụ3 :
Hai macro dưới đây sẽ chọn toàn bộ các ô trống trong trang tính.

Sub ChonToanORong()
    ActiveSheet.UsedRange.SpecialCells(xlCellTypeBlanks).Select
End Sub

Sub ChonToanORong2()
    Range("A1").SpecialCells(xlCellTypeBlanks).Select  
End Sub

Ta có thể thấy khi chỉ định Range ở trường hợp sau có lúc sẽ cho kết quả không như ý.

Ví dụ 4:
Phương thức SpecialCells với các ô công thức và ô chứa dữ liệu
Chúng ta không thể kết hợp nhiều hơn một XlCellType (ví dụ xlCellTypeConstants + xlCellTypeFormulas). Ta có thể dùng phương thức SpecialCells để chỉ trả về một loại trong các ô đã dùng (công thức hay hằng số) và bỏ đi những ô chứa dữ liệu dạng văn bản (công thức & hằng số).

Sub AllNummericCells()
Dim ConClls As Range, ForClls As Range
Dim AllRng As Range
    Set AllRng = ActiveSheet.UsedRange
    On Error Resume Next   'Trường hợp không có công thức hay hằng số dạng số
     ' Mọi ô chứa số liệu dạng số được gán vô biến:
    Set ConClls = AllRng.SpecialCells(xlCellTypeConstants, xlNumbers)
    ' Các ô công thức dạng số được gán vô biến đã khai báo:
    Set ForClls = AllRng.SpecialCells(xlCellTypeFormulas, xlNumbers)
    ' Xác định kiểu của dữ liệu dạng số (công thức, hằng số hay khác):
    If ConClls Is Nothing And ForClls Is Nothing Then
       MsgBox "Trang Tinh Cua Ban Khong Chua Du Lieu So"
       End
    ElseIf ConClls Is Nothing Then
       Set AllRng = ForClls	 'Công thức
    ElseIf ForClls Is Nothing Then
       Set AllRng = ConClls	 'Số liệu thuần
    Else
       Set AllRng = Application.Union(ForClls, ConClls) 	' Cả hai
    End If
    On Error GoTo 0
    AllRng.Select
End Sub

Ta luôn nên ghi dòng lệnh

On Error Resume Next

như trong đoạn mã trên. Điều này rất cần thiết khi điều kiện của phương thức SpecialCells không thỏa và gây lỗi. Để bãy lỗi này ta kiểm tra biến kiểu Range mà ta đã gán có tồn tại hay không. Trong đoạn mã trên câu lệnh If (với 2 ElseIf) kiểm tra điều này.

Ví dụ 5:
Tiện lợi rất nhiều về thời gian một khi ta dùng phương thức này thay cho cách dùng vòng lặp như thông thường
Ta xét 2 macro sau:

Sub DoLoop()
Dim Blclls As Range
   For Each Blclls In Range("b2:F350")
	If IsEmpty(Blclls) Then Blclls = "Rong"
   Next Bcell
End Sub

Macro này sẽ phải lần lượt duyệt qua toàn bộ các ô trong vùng chọn (“B2:F350"). Khi gặp ô nào không chứa dữ liệu (rỗng) thì nó điền thay vô đó từ "Rong”.

Còn macro dưới đây thì tiếp cận với các ô rỗng theo phương thức chọn toàn bộ các ô rỗng cùng một lúc & chỉ bằng 1 dòng lệnh duy nhất.

Sub SpecialCells5()
    If WorksheetFunction.CountA(Range("b2:F350")) = 0 Then
       MsgBox "TOAN BO O LA RONG", vbOKOnly, "GPE.COM"
       Exit Sub
    End If
    On Error Resume Next
    Range("b2:F350").SpecialCells(xlCellTypeBlanks) = "Rong"
End Sub

Ví dụ 6:
Tô màu các ô chứa giá trị & các ô công thức cùng nhỏ hơn mộtr giá trị nào đó.

Macro mà chúng ta dùng để tô màu nền các ô chứa các trị bế hơn 10 & kể cả các ô chứa công thức, mà kết quả công thức trả về cũng là những giá trị bé hơn 10. Nó gồm các dòng lệnh sau:

Sub BackColor()
Dim ConClls As Range, ForClls As Range, AllClls As Range, Clls As Range
Set AllClls = ActiveSheet.UsedRange:	AllClls.Select
On Error Resume Next
Set ConClls = AllClls.SpecialCells(xlCellTypeConstants, xlNumbers)
Set ForClls = AllClls.SpecialCells(xlCellTypeFormulas, xlNumbers)
    If ConClls Is Nothing And ForClls Is Nothing Then
       MsgBox "Trang Tinh Không Chứa Số":	End
    ElseIf ConClls Is Nothing Then
       Set AllClls = ForClls     'Công thức
    ElseIf ForClls Is Nothing Then
       Set AllClls = ConClls     ' Số Trị
    Else
       Set AllClls = Application.Union(ForClls, ConClls) 	'Cả Hai
    End If
    On Error GoTo 0
    For Each Clls In AllClls
      With Clls
          If .Value < 10 Then   .Interior.ColorIndex = 36
       End With    
 Next Clls
End Sub

Những gì mà macro vừa thực hiện, được hiển thị trên hình 2:

Tại cột ‘A’, là những giá trị do các công thức tại A(j+1) = IF(A(j) = “TT”; 1; A(j)1 + 1).
Tại cột ‘E’, những giá trị bé hơn 10 đều được tô màu vàng nhạt

Ví dụ 7:
Về ô cuối cùng chứa dữ liệu
Nếu ta viết macro có nội dung sau:

Sub LastCells()
      	Range("A1").SpecialCells(xlCellTypeLastCell).Select
	MsgBox Selection.Address
End Sub

Thì hộp thoại sẽ đưa ra địa chỉ ô, mà ô này chưa chắc phải là ô cuối cùng chứa dữ liệu trong vùng sử dụng.
Để trả lời vấn đề này, ta đọc lại phần đầu của đề mục viết về tham số xlCellTypeLastCell.
Vậy khi ta muốn tìm tới ô cuối cùng chứa dữ liệu của trang tính thì làm sao đây? Lúc đó ta phải dùng macro như sau để đạt mục đích:

Sub FindLastCell()
Dim LastColumn As Integer:	
Dim LastRow As Long
Dim LastCell As Range
   If WorksheetFunction.CountA(Cells) > 0 Then
      LastRow = Cells.Find(What:="*", After:=[A1], _
               SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            LastColumn = Cells.Find(What:="*", After:=[A1], _
               SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
            MsgBox Cells(LastRow, LastColumn).Address
   End If
End Sub

Với cơ sở dữ liệu như trong h.3, ta sẽ thấy hộp thoại của macro đưa ra địa chỉ như trong hình đã dẫn.

Phần 2: Các ứng dụng có liên quan đến phương thức SpecialCells

1. Xóa các dòng rỗng trong cơ sở dữ liệu

Sub DeleteBlankRows1()
'Xóa dòng rỗng trong vùng đã chọn
On Error Resume Next
Selection.EntireRow.SpecialCells(xlBlanks).EntireRow.Delete
On Error GoTo 0
End Sub

Sub DeleteBlankRows2()
'Cũng xóa dòng rỗng trong vùng đã chọn
Dim BlRng As Range
If WorksheetFunction.CountA(Selection) = 0 Then
   MsgBox "Khong Tim Ra Du Lieu", vbOKOnly, "GPE.com"
   Exit Sub
End If
With Application
   .Calculation = xlCalculationManual
   .ScreenUpdating = False
   Selection.SpecialCells(xlCellTypeBlanks).Select
   For Each BlRng In Selection.Rows
      If WorksheetFunction.CountA(Selection.EntireRow) = 0 Then
         Selection.EntireRow.Delete
      End If
   Next BlRng
   .Calculation = xlCalculationAutomatic
   .ScreenUpdating = True
 End With
End Sub

2. Cẩn thận với xlCellTypeVisible khi viết trong hàm người dùng

Nếu chúng ta có ý tưởng viết hàm người dùng để nó đếm cho ta số ô trong vùng nào đó, ví dụ bằng cách thức sau:

Public Function KhongHieuNoi(Rng As Range)
    KhongHieuNoi = Rng.SpecialCells(xlCellTypeVisible).Cells.Count
End Function

Thì hàm này hoàn toàn đúng về cú pháp, cũng như biên dịch ra ngôn ngữ máy, . . . Thậm chí trong cửa sổ Immediate, ta nhập câu lệnh sau:

?khonghieunoi(sheet3.UsedRange)

Sau khi {ENTER}, chúng ta sẽ nhận được 1 kết quả rất chi là chính xác nữa là đằng khác.
Nhưng vấn đề sẽ khác, một khi ta xét hàm người dùng này & được đối chiếu với 1 macro có những câu lệnh tương tư. Muốn vậy, ta tạo 1 vùng nào đó trên trang tính & gán cho nó cái tên ‘DSach’ (Trong hình 4 là vùng ‘A1:B21’). Tại ô ‘D3’ ta nhập công thức:

=KhongHieuNoi(DSach)

Sau khi {ENTER} ta được giá trị 42. Giá trị này vẫn tồn tại cho dù bạn có ẩn vài hàng hay ẩn đi 1 cột, hoặc thậm chí ẩn cả hai cột ‘A’ & ‘B’ đi chăng nữa.
Sự thật phủ phàng này (vẫn như cũ, luôn xuất hiện số 42) nên ghi nhớ mãi, một khi làm việc với những ô ‘trông thấy’ trong các hàm tự tạo trong excel.
Ngược lại với hàm người dùng như trên, với macro HieuKhong() sau đây vấn đề sẽ hoàn toàn khác

Sub HieuKhong()
 On Error Resume Next
 [D4]= Sheet3.[DSach].SpecialCells(xlCellTypeVisible).Cells.Count
End Sub

Cặp mắt của macro này giống với cặp mắt của chúng ta, và kết quả của hàm hay của macro ghi ra không trùng nhau, như hình dưới đây:

 

[levanduyet]

(Tiếp theo)

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.

 

[levanduyet]

2. Highlight hàng khi di chuyển chuột - Highlight row when moving the mouse
Trên diễn đàn có nhiều bài viết về vấn đề này, tôi xin chọn ra 2 tập tin tương đương với 2 cách để đưa vào đây.

Cách thứ nhất: là dùng Conditional Formatting.
Các bạn thực hiện các bước như hình:
Bước 1: Chọn vùng bạn muốn highlight (tô màu) khi di chuyển.
Bước 2: Chọn Conditional Formatting > Use a formula to determine which cells to format và nhập vào công thức

=ROW()=CELL("ROW")

(Bạn chú ý hai hàm ROW và CELL ở trong công thức - Các bạn có thể đọc phần help về hai hàm này)
Các bạn cũng có thể phối hợp các hàng khác, để khi bạn di chuyển phải bảo đảm rằng giá trị công thức trả về khi bạn chọn hàng hiện hành là TRUE.

Sau đó chọn định dạng như: Bold, màu nền, màu chữ,... theo ý của bạn. Cuối cùng chọn nút "OK" để áp dụng.



Bước cuối cùng là đưa vào thủ tục sự kiện

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.ScreenUpdating = True
End Sub

Như vậy bạn khi di chuyển ô chọn bạn sẽ thấy định dạng theo như bạn muốn.
Các bạn có thể download tập tin tại đây.

Cách trên được đưa ra bởi bạn hoangminhtien.

Cách thứ hai: là kết hợp giữa các hàm Window API.
Cách này của thành viên rollover79.
Ở cách này tác giả có hai nút để các bạn quyết định bắt đầu hay không bắt đầu Highlight.

Để thực hiện, các bạn hãy tạo một module và đưa đoạn mã sau vào:

Private Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long

Public curCell As Range

Public Type POINTAPI
    X          As Long
    Y          As Long
End Type

Private CursorPos As POINTAPI
Private CursorCell As Range
Public bActive As Boolean

[COLOR="#008000"]' Thủ tục này sẽ được gọi khi bạn muốn bắt đầu quá trình Highlight hàng[/COLOR]
Sub Active()
    On Error Resume Next
    If bActive Then Exit Sub
    SetTimer Application.hWnd, 1, 250, AddressOf RowAlternative
    bActive = True
End Sub

[COLOR="#008000"]' Thủ tục này sẽ được gọi khi bạn muốn kết thúc quá trình Highlight hàng[/COLOR]
Sub DeActive()
    On Error Resume Next
    bActive = False
    KillTimer Application.hWnd, 1
    ActiveSheet.Rows(curCell.Row).FormatConditions(1).Delete
End Sub

[COLOR="#008000"]' Thủ tục chính để tô màu hàng tại vị trí con trỏ[/COLOR]
Private Function RowAlternative()
    On Error Resume Next

    Dim RetVal As Long
    RetVal = GetCursorPos(CursorPos)
    RetVal = WindowFromPoint(CursorPos.X, CursorPos.Y)
    
    [COLOR="#008000"]' Sẽ không thực hiện nếu ứng dụng không phải là Excel[/COLOR]
    If (Application.Name <> "Microsoft Excel") Then Exit Function
    Set CursorCell = Application.Windows(1).RangeFromPoint(CursorPos.X, CursorPos.Y)

    If Err.Number = 0 Then
       [COLOR="#008000"] ' Thực hiện xóa tô màu ở hàng cũ, và tô màu ở hàng mới[/COLOR]
        If CursorCell.Address <> curCell.Address Then
            ActiveSheet.Rows(curCell.Row).FormatConditions(1).Delete
            Set curCell = CursorCell
            ActiveSheet.Rows(curCell.Row).FormatConditions.Add xlExpression, , "=true"
            ActiveSheet.Rows(curCell.Row).FormatConditions(1).Interior.ColorIndex = 24
        End If
    End If
End Function

Nguyên tắc của cách hai là, dùng các hàm API để xác định vị trí của chuột và tô màu ở hàng này. Đây là một cách làm sáng tạo.
Như vậy với cách làm này thì khi bạn di chuyển bằng các phím mủi tên thì cách này không thể áp dụng được.

Các bạn có thể tải tập tin tại đây.

Link của topic nói về vấn đề này tại đây.

Cách thứ ba: là dựa vào thủ tục sự kiện Worksheet_SelectionChange.

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
    Const cnNUMCOLS As Long = 256
   [COLOR="#00FF00"] ' Màu mặc định là màu vàng[/COLOR]
    Const cnHIGHLIGHTCOLOR As Long = 36               '
    Static rOld As Range
    Static nColorIndices(1 To cnNUMCOLS) As Long
    Dim i      As Long
    If Not rOld Is Nothing Then                      [COLOR="#00FF00"] ' Phục hồi lại màu nền của ô cũ[/COLOR]
        With rOld.Cells
            If .Row = ActiveCell.Row Then Exit Sub    [COLOR="#00FF00"]' Cùng một hàng không phục hồi[/COLOR]
            For i = 1 To cnNUMCOLS
                .Item(i).Interior.ColorIndex = nColorIndices(i)
            Next i
        End With
    End If
    Set rOld = Cells(ActiveCell.Row, 1).Resize(1, cnNUMCOLS)
    With rOld
        For i = 1 To cnNUMCOLS
            nColorIndices(i) = .Item(i).Interior.ColorIndex
        Next i
        .Interior.ColorIndex = cnHIGHLIGHTCOLOR
    End With
End Sub

Với đoạn mã ở trên, việc thực thi sẽ chậm nếu có nhiều ô trong cùng một hàng phải phục hồi màu nền.

Hoặc đơn giản hơn ta có thể dùng đoạn mã sau:

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
        Cells.Interior.ColorIndex = xlColorIndexNone
        ActiveCell.EntireRow.Interior.ColorIndex = 36
End Sub

Nguồn: http://www.mcgimpsey.com/excel/highlightrow.html



Lê Văn Duyệt

 

[levanduyet]

3. Dùng Macro 4 để tạo menu:

Macro 4 tuy ra đời đã lâu nhưng có một số trường hợp nếu chúng ta áp dụng chương trình của chúng ta sẽ nhanh và gọn hơn.

Tài liệu về Macro 4 các bạn có thể tham khảo tại đây.

Tôi xin hướng dẫn các bạn các dùng Macro 4 để tạo menu có dạng như sau:

Đầu tiên các bạn hãy tạo một workbook mới.

Sau đó bạn click phải chuột vào tên của Sheet, chọn Insert...

Bạn chọn MS Excel 4.0 Macro

Bạn sẽ có một sheet Macro1.

Sau đó các bạn hãy đặt lại tên là Menu

Ở cột 1 chúng ta sẽ đưa vào các đoạn mã để tạo vào xóa menu.
Dữ liệu chúng ta sẽ đưa vào từ cột 4.

Bạn hãy nhập thông tin về tên menu, rồi thủ tục sẽ được thực hiện khi click vào menu này như hình sau.

Chúng ta sẽ đặt tên như sau (đánh dấu vùng rồi nhấn tổ hợp phím Ctrl + F3, nhập vào tên):
_ Cột 4 hàng 1 đến cột 5 hàng 6: mymenu (Vùng để tạo menu, hàng đầu tiên sẽ là tên menu, kế đến là caption của menu, cột kế bên sẽ là thủ tục thực hiện khi người dùng nhấn vào.
_ Ô ở cột 4 hàng 1: tenmenu (Tên menu người dùng)

Ở cột đầu tiên ta sẽ nhập vào đoạn mã sau:

=ERROR(0)
=ADD.MENU(10,mymenu)
=RETURN()


=ERROR(0)
=DELETE.MENU(10,tenmenu)
=RETURN()

Đến đây các bạn hãy để ý các câu lệnh:

=ERROR(0)

Xóa các lỗi xãy ra.

=ADD.MENU(10,mymenu)

Thêm vào menu. Bạn chú ý đến việc bố trí của nó như tôi đã trình bày ở trên.

=DELETE.MENU(10,tenmenu)

Xóa menu có tên là tenmenu

=RETURN()

Kết thúc thực hiện các câu lệnh.

Bây giờ làm sao để thực hiện các đoạn mã ở trên khi workbook mở, hoặc đóng?

Bạn hãy chọn ô 1 hàng 1 và đặt tên là Autpen
Có nghĩa là thủ tục này sẽ tự động thực hiện mỗi khi mở workbook này ra.
Chú ý: thủ tục Autpen này sẽ thực hiện từ ô này đi xuống đến khi gặp câu lệnh =RETURN()

Và chọn ô 1 hàng 6 và đặt tên là Auto_Close
Có nghĩa là thủ tục này sẽ tự động thực hiện mỗi khi đóng workbook này lại.

Bây giờ các bạn hãy đặt Password cho Macro Sheet này.

Sau đó chúng ta sẽ ẩn Macro Sheet này đi.
Bạn hãy tạo một module cho workbook này (Alt + F11 > Insert > Module)
Rồi nhập vào đoạn mã sau:

Sub Dau_Macro4_Sheet()
    ThisWorkbook.Sheets(1).Visible = xlSheetVeryHidden
End Sub

Mục đích của đoạn mã ở trên là ẩn Macro Sheet. Nếu ẩn bằng cách này thì bạn chỉ có thể mở ra bằng code mà thôi, chứ không thể UnHide bằng cách thông thường (tức là Click phải chuột vào Sheet, rồi chọn UnHide).

Chú ý muốn thấy lại được thì bạn phải dùng đoạn mã sau:

Sub Hien_Macro4_Sheet()
    ThisWorkbook.Sheets(1).Visible = xlSheetVisible
End Sub

Bây giờ các bạn có thể xóa các đoạn mã này và xóa luôn module này khỏi tập tin của bạn.

Trong cửa sổ VBE của bạn hãy vào Tools> VBAProject Properties...

Ở Tab: Protection bạn click chọn vào Lock project for viewing
Sau đó nhập vào Password.

Bây giờ các bạn hãy thử đóng và mở lại tập tin chúng ta vừa tạo xem sao?

Khi người dùng mở ra ở chế độ Enable Macro thì sẽ có một menu hiện ra.

Như vậy chương trình của các bạn xem ra "có vẻ chuyên nghiệp".

Chúc các bạn thành công.

Lê Văn Duyệt