/(/hững ghi chép về phương thức SpecialCells

SA_DQ · 1/1/07

Phần giới thiệu nguồn tài nguyên trên mạng:

Mã:

[size=2][b]                               The SpecialCells Method in Excel VBA[/b][/size]

One of the most beneficial Methods in Excel (in my experience) is the SpecialCells Method. When used, it returns a Range Object that represents only those type of cells we specify. For example, one can use the SpecialCells Method to return a Range Object that only contains formulae. In fact, we can, if we wish, even narrow it down further to have our Range Object (containing only formulae) to return only formulae with errors.
The syntax for the SpecialCells Method is;
expression.SpecialCells(Type, Value)
Where "expression" must be a Range Object. For example Range("A1:C100"), ActiveSheet.UsedRange etc.
Type=XlCellType and can be one of these XlCellType constants.
xlCellTypeAllFormatConditions. Cells of any format
xlCellTypeAllValidation. Cells having validation criteria
xlCellTypeBlanks. Empty cells
xlCellTypeComments. Cells containing notes
xlCellTypeConstants. Cells containing constants
xlCellTypeFormulas. Cells containing formulas
xlCellTypeLastCell. The last cell in the used range. Note this XlCellType will include empty cells that have had any of cells default format changed.
xlCellTypeSameFormatConditions. Cells having the same format
xlCellTypeSameValidation. Cells having the same validation criteria
xlCellTypeVisible. All visible cells
These arguments cannot be added together to return more than one XlCellType.
Value=XlSpecialCellsValue and can be one of these XlSpecialCellsValue constants.
xlErrors
xlLogical
xlNumbers
xlTextValues
These arguments can be added together to return more than one XlSpecialCellsValue.
The SpecialCells Method can be used in a wide variety of situations when you only need to work with cells housing specific types of data. For example, the code below would return a Range Object representing all formulae on the active Worksheet.
ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas)
If we wanted, we could narrow this down further to only return a Range Object representative of all formulae that are returning numbers.
ActiveSheet.UsedRange.SpecialCells(xlCellTypeFormulas,xlNumbers)
Once we have the specific Range Object type returned we can then work with only those cells. This can often be done in one line of code, or you may need to loop through the range. See examples below;

Mã:

Sub ColorAllFormulae()
    ActiveSheet.UsedRange.SpecialCells _
     (xlCellTypeFormulas).Interior.ColorIndex = 36
End Sub
Sub NegativeAllNumberFormula()
Dim rRange As Range, rCell As Range
    Set rRange = ActiveSheet.UsedRange.SpecialCells _
     (xlCellTypeFormulas, xlNumbers)
     For Each rCell In rRange
        rCell = rCell.Value * -1
     Next rCell
End Sub

Although I have used a loop on the second macro, so that all returned numbers are converted to their negative counterparts, we could make use of PasteSpecial to do so without looping and allow the formulae to remain in the cells. That is;

Mã:

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

SpecialCells Gotcha!
If you are familiar with Excel and it's built in features, such as SpecialCells, you will know that when/if one specifies only a single cell (via Selection or Range) Excel will assume you wish to work with the entire Worksheet of cells. For example, the 2 macros below would both select ALL blank cells on a Worksheet.

Mã:

Sub SelectAllBlanks()
    ActiveSheet.UsedRange.SpecialCells(xlCellTypeBlanks).Select

End Sub

Sub SelectAllBlanks2()

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

So, as you can see, specifying only a single cell Range can give unwanted results.
SpecialCells for Formulae & Constants
While we cannot specify more than one XlCellType (e.g. xlCellTypeConstants+xlCellTypeFormulas would fail) we can use the SpecialCells method to return only used cells housing numbers on a Worksheet (formulae & constants) and omit any cells containing text (formulae & constants).

Mã:

Sub AllNummericCells()
Dim rCcells As Range, rFcells As Range
Dim rAcells As Range

    [color="Blue"]'Set variable to all used cells [/color]
    Set rAcells = ActiveSheet.UsedRange

    On Error Resume Next 'In case of no numeric formula or constants.

    [color="Blue"]'Set variable to all numeric constants[/color]
    Set rCcells = rAcells.SpecialCells(xlCellTypeConstants, xlNumbers)
    'Set variable to all numeric formulas
    Set rFcells = rAcells.SpecialCells(xlCellTypeFormulas, xlNumbers)
    [COLOR="Blue"]'Determine which type of numeric data (formulas, constants or none)[/COLOR]    
    If rCcells Is Nothing And rFcells Is Nothing Then
       MsgBox "You Worksheet contains no numbers"
       End
    ElseIf rCcells Is Nothing Then
       Set rAcells = rFcells    [color="Blue"] 'formulas[/color]
    ElseIf rFcells Is Nothing Then
       Set rAcells = rCcells      [color="Blue"]'constants [/color]
    Else
       Set rAcells = Application.Union(rFcells, rCcells) [color="Blue"] 'Both[/color]
    End If
    On Error GoTo 0

    rAcells.Select
End Sub

You should take note of the On Error Resume Next statement in the above code. This is needed as when the SpecialCells Method condition cannot be met an error occurs. As you may, or may not know, a non valid Range Object returns the Nothing keyword. After Setting a Range variable to the SpecialCells Method we need to then check that we have been able to pass a Range Object to our Range variable. It is the If Statement (and 2 ElseIf) that checks this in the code above.
(Tại: http://www.ozgrid.com/forum/showthread.php?t=61732&highlight=specialcells)

Phần giúp đỡ trong cửa sổ VBA:

Bạn vô CS (cửa sổ) VBA bằng tổ hợp fím ALT+{F11} & nhập các kí tự sau: SpecialCells. Sau đó bôi toàn bộ tên phương thức & nhấn {F1} để được excel giải thích; Tuy nhiên giải thích này có thể làm chúng ta cảm thấy không đủ so với những gì đã ghi trên diễn đàn đã nêu như trên;
/(/hững áp dụng cụ thể
A. Ta xem lại lần lượt các ví dụ nêu trên:
1.- Tô màu nền cho các ô trống trong vùng sử dụng
Giả dụ trên trang tính trắng ta nhập ‘Nam’ vô ô B2; ‘Thanh’ vô C3 & ‘Chanh’ vô ô D4 & cho chạy macro ColorAllFormulae để biết xem những ô nào được tô màu nền?!
2.- Đổi dấu dữ liệu của các ô công thức
Bằng cách sử dụng một trong hai macro đã nêu NegativeAllNumberFormula & NegativeAllNumberFormula2
3.- Các trường hợp đếm các ô không chứa dữ liệu
Để hiểu rõ hơn về câu lệnh UsedRange.SpecialCells(x) ta xét đến ví dụ sau: Ta có trang tính trắng; Tại D4 ta nhập tên ‘Lê’; ô D5 nhập ‘Hoa’ & ô D6 ta nhập =D4 & “ “ & D5. Sau đó cho chạy macro sau:

Mã:

[b]
Sub CountAllBlanks()[/b]
    ActiveSheet.UsedRange.SpecialCells(xlCellTypeBlanks).Select:    MsgBox Selection.Count
    Range("A1").SpecialCells(xlCellTypeBlanks).Select:                      MsgBox Selection.Count
[b]End Sub [/b]

4.- Chọn vùng dữ liệu chứa công thức hay trị kiểu số
Bằng macro AllNummericCells
B. Ta xem các phương án ứng dụng khác nhau trong 1 macro sau đây:

Mã:

[b]Sub FillBlanks()[/b]
 Dim Rng As Range:               Dim iZ As Integer
 iZ = InputBox("CHON PHUONG AN:", , "9")
 Select Case iZ
 Case 1  [color="Blue"]’a: Nhập trị ‘0’ cho toàn thể các ô trống trong vùng chọn [/color]
    Range("C1:D9").SpecialCells(xlCellTypeBlanks).Value = 0
 Case 2 [color="Blue"]’b: Xóa giá trị các ô trên cột ‘A’ tương ứng với các ô trên cột B là trống [/color]
    Columns("B:B").SpecialCells(xlCellTypeBlanks).Offset(0, -1).ClearContents
 Case 3[color="Blue"] ‘c: Ẩn/Xóa các dòng trong vùng từ 10 đến 40 khi ô trên cột A tương ứng là trống [/color]
    Set Rng = Range("A10:A40").SpecialCells(xlBlanks).EntireRow
    Rng.Hidden = True
    '    Range("A10:A40").SpecialCells(xlBlanks).EntireRow.Delete
 Case 4 [color="Blue"] ‘d: Hiện số dòng & địa chỉ của chúng, khi chúng không ẩn[/color]
    Set Rng = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Rows
    MsgBox ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Rows.Count, , Rng.Address
Case 5[color="Blue"] ‘đ: Xóa giá trị các ô chứa số liệu, nhưng không là công thức [/color]
    ActiveSheet.Cells.SpecialCells(xlCellTypeConstants, 23).ClearContents
 Case 6[color="Blue"] ‘e: Xóa giá trị các ô chứa số liệu trong vùng đặt tên [b]‘ConstantRef’[/b] [/color]
    On Error Resume Next   
    Range("ConstantRef").SpecialCells(xlCellTypeConstants).ClearContents
    On Error GoTo 0
'[Color="Blue"] * * * Thêm Mới  [/Color]
 Case 7
    Dim lLastRow As Long, iLastCol As Integer
     Set Rng = Range("A1").SpecialCells(xlCellTypeLastCell)
    lLastRow = Rng.Row:             iLastCol = Rng.Column
         MsgBox Rng.Address, , Str(lLastRow) & Str(iLastCol)
  Case 8
    For Each Rng In Cells.SpecialCells(xlCellTypeConstants, xlNumbers)
        If Not IsDate(Rng.Value) Then Rng.ClearContents
    Next Rng
'[Color="Blue"] * * *  [/Color]
case else
 End Select
[b]End Sub[/b]

Tiếp phần 2

SA_DQ · 3/1/07

Phương thức SpecialCells (tiếp theo).

C. Tự nghiên cứu macro sau đây:

Mã:

[b]Sub CountBlanks()[/b]
    Dim lCount As Long
            On Error Resume Next
    lCount = Range("C9:H9,L9:Q9").SpecialCells(xlCellTypeBlanks).Cells.Count
    On Error GoTo 0
    Select Case lCount
    Case 0 To 1
        Exit Sub
    Case 2
         [color="blue"]'Do stuff[/color]
    Case 6
         [color="blue"]'Do stuff[/color]
    Case Else
         [color="blue"]'Do stuff[/color]
    End Select
[b]End Sub[/b]

D. Các macro có thể gặp trong thực tế sau đây:
1./ Ẩn hay xóa dòng dữ liệu theo các điều kiện
Một khi ta muốn xóa (hay làm ẩn đi) một số dòng dữ liệu theo nhiều điều kiện khác nhau ta cò thể nhờ đến Mcr (macro) DeleteRowsWithSpecifiedData sau đây.

Mã:

[b]Sub DeleteRowsWithSpecifiedData()[/b]
29    Dim Rng As Range
1    Sheets("S3").Select:			    Columns(1).EntireColumn.Insert
 2   With Range("A1:A" & ActiveSheet.UsedRange.Rows.Count)
  3      .FormulaR1C1 = _
            "=IF(AND(     OR(ISTEXT(RC[1]), ISBLANK(RC[1]), LEFT(RC[4],4)=""PAGE""), LEFT(RC[5],5)<>""TOTAL""),NA(),FALSE)"
4        .Value = .Value
21        If Rng Is Nothing Then
22            Set Rng = .SpecialCells(xlCellTypeConstants, xlErrors).EntireRow
23        Else
24            Rng = Union(Rng, .SpecialCells(xlCellTypeConstants, xlErrors).EntireRow)
25        End If
9        On Error Resume Next
'11        .SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
 5   End With
6    On Error GoTo 0
28    Rng.Hidden = True
7   Columns(1).EntireColumn.Delete
[b]End Sub[/b]

Thủ tục này gộp chung của hai phương án, đó là làm ẩn hay xóa dòng dữ liệu. Hiện tại thủ tục áp dụng trong phương thức ẩn các dòng dữ liệu thỏa các điều kiện. Khi muốn Mcr thực thi phương án xóa dòng dữ liệu ta phải:
a./ Vô hiệu hóa các dòng lệnh có số lớn hơn 20 (bằng cách thêm dấu nháy đơn vô trước dòng lệnh)
b./ Hiệu lực hóa dòng lệnh số 11 (bỏ đi dấu nháy đơn đầu dòng lệnh)
Ta xét cụ thể trường hợp Mcr làm ẩn các dòng dữ liệu theo điều kiện nêu tại dòng lệnh 3, như sau:
Trước tiên, Mcr thêm 1 cột vô trang tính, trở thành cột A mới;
Tiếp theo là dòng lệnh yêu cầu khảo sát vùng A1:A(i), ở đây i là dòng cuối cùng của trang tính có chứa dữ liệu;
(Dòng lệnh thứ 3 khỏi diễn dịch! Hơn nữa trong thực tế nó sẽ bị thay đổi theo yêu cầu cụ thể của ta)
Các dòng lệnh từ 21..25 nói rằng:
Nếu biến Rng chưa được gán trị thì gán bằng dòng có ô A(j) hiện hành đang chứa giá trị lỗi (NA())
Ngược lại, nếu Rng đã được gán thì thêm vô nó một dòng nữa (bằng phương thức UNION).
Dòng lệnh 28 làm ẩn vùng địa chỉ chứa trong biến Rng;
Cuối cùng là xóa cột phụ mà Mcr đã tạo, để trả về trạng thái địa chỉ ô của trang tính ban đầu.
2./ Khử lần lượt các ô trống trong 4 cột đầu tiên của dữ liệu

Mã:

[b]Sub DeleteBlanks()[/b]
    Dim intCol As Integer
    For intCol = 1 To 4  [Color="Blue"] '* * *  Cols A to D  [/color]
        Range(Cells(2, intCol), Cells(333, intCol)).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
    Next intCol
[b]End Sub [/b]

Bắt đầu từ cột A, Mcr sẽ chép dữ liệu phía dưới lên ô trống một cách liên tục.
Ví dụ cột A từ A2 đến A336 có hai ô trống thì sau khi Mcr chạy gần nữa đoạn đường, thì tại cột A dữ liệu sẽ có từ A2 đến A334
3./ Xóa các dòng thõa một trong hai điều kiện tại hai cột
Giả dụ ta có 1 cơ sở dữ liệu về học sinh. Cuối năm cần lập DS (danh sách) những em được lên lớp; DS chỉ là những học sinh tại thành phố (trường [TINH] tại cột ‘N’ hiện có các mã HCM, DN, LA, BD & BT); Học sinh ở lại lớp đã được ghi chú vô cột ‘O’. gồm có ‘HK Kem’, ‘O Lai’, ‘Nghi Hoc’ & ‘Bo Hoc’. Mcr dưới đây sẽ thực thi nhiệm vụ một cách hoàn hảo:

Mã:

[b]Sub XoaDongTheoDuLieu()[/b]
    Dim RngTest As Range, RngSelect As Range, rng As Range
     [Color="Blue"]'Fill any blank in column "O" with formula [/color]
    Set RngTest = Intersect(ActiveSheet.UsedRange, Columns("N:O"))
    RngTest.Columns(2).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=rc[-1]"
     [Color="Blue"] 'Selects all cells in columns "N" and "O" that match [/color]
    For Each rng In RngTest
        If rng = "LA" Or rng = "DN" Or rng = "BT" Or rng = "BD"  Or rng = "HK Kem" _
            Or rng = "O Lai" Or rng = "Nghi Hoc" Or rng = "Bo Hoc" Then
            If RngSelect Is Nothing Then Set RngSelect = rng
            Set RngSelect = Union(RngSelect, rng)
        End If
    Next rng
  [Color=”Blue”]'Deletes rows that match[/color]
RngSelect.EntireRow.Delete
[b]End Sub[/b]

Trong thủ tục có dùng hai phương thức Intersect & Union. Hai phương thức này mình đã có giới thiệu một bài trên diễn đàn. (Tìm kiếm bằng từ khóa Intersect)

4./ Biến các ô công thức trong vùng chọn thành dữ liệu

Mã:

[b]Sub ValuesOnly()[/b]
    Dim rRange As Range, RngSC As Range:              Dim lCalc As Long
      On Error Resume Next
3    Set rRange = Application.InputBox(Prompt:="Select the formulas", Title:="VALUES ONLY", Type:=8)
4    Set RngSC = rRange.SpecialCells(xlCellTypeFormulas)
    If RngSC Is Nothing Then Exit Sub
6    Set rRange = Application.Intersect(rRange, RngSC)
    If rRange Is Nothing Then Exit Sub
    On Error GoTo 0
9    With Application
        .ScreenUpdating = False:                            lCalc = .Calculation
        .Calculation = xlCalculationManual
12    End With
    Set RngSC = Nothing
14    For Each RngSC In rRange
            RngSC = RngSC.Value         [color="Blue"]		 '   rRange = rRange.Value [/color]
16     Next RngSC
17    With Application
        If Not lCalc = 0 Then .Calculation = lCalc
        .ScreenUpdating = True
20    End With
21    Set rRange = Nothing: Set RngSC = Nothing
[b]End Sub[/b]

Câu lệnh 3 yêu cầu ta nhập vô chuỗi biểu thị vùng dữ liệu cần thiết biến từ dạng công thức sang dạng dữ liệu, ví dụ: ‘A1:B99’ hay ‘A$9:$B500’ hoặc ‘$A$2:$U$78’
Câu lệnh 4: Các ô chứa công thức trong vùng chọn trên được đem gán vô biến RngSC đã khai báo.
Câu lệnh 6: Các ô nào thõa với phương thức Intersect giữa ô công thức (c 4) & vùng chọn ban đầu (c3) được gán lại vô biến rRange;
Các câu lệnh 5, 7 dùng để thoát khỏi chương trình khi không có ô nào thõa điều kiện;
Câu lệnh 15 chính là câu biến các ô chứa công thức thành các ô chứa trị;
Cuối cùng, câu lệnh 21 dùng để báo là chúng ta không xài các biến thuộc loại Range nữa; Mục đích chủ yếu là thu hồi bộ nhớ, tránh lãng phí tài nguyên.
5./ Sao chép vùng lọc sang một Sheet mới
Trong Mcr sau chúng ta có dịp xem xét đến cách sử dụng phương thức SpecialCells đối với trang tính đã qua lọc. Sau khi thực hiện lọc từ các dòng dữ liệu, chúng ta muốn chuyển chúng sang một sheet khác để làm báo cáo, thì Mcr CopyAFilter sẽ phục vụ bạn một cách miễn phí:

Mã:

[b]Sub CopyAFilter()[/b]
    Dim Rng As Range    
    With Sheet3
        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)
[color="blue"]         'set a range = to visible cells (excluding the header)[/color]
        Rng.Copy Destination:=Sheet4.Range("A1")
    End With
[b]End Sub[/b]

6./ Các bạn tự tìm hiểu 3 Mcr này:

Mã:

[b]Sub DeleteStuff()[/b]
    Dim Rng As Range
    Set Rng = Range("Q2:Q" & Cells(65536, "Q").End(xlUp).Row)
    If ActiveSheet.AutoFilterMode Then Cells.AutoFilter
    Columns("Q").AutoFilter Field:=1, Criteria1:="="
    On Error Resume Next 'in case nothing found to delete
    Rng.SpecialCells(xlCellTypeVisible).EntireRow.Delete
    On Error GoTo 0
    ActiveSheet.AutoFilterMode = False
[b]End Sub[/b]

Mã:

 [b]
Sub MAreas1() [/b]
    If ActiveSheet.FilterMode = True Then [color="blue"]        'Select first row below heading[/color]
        ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Areas(2).Select
 [color="blue"]       '   *   Will tell you the actual row number of the second visible row[/color]
        MsgBox ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Areas(2).Rows(1).Row
    End If
[b]End Sub[/b]

Mã:

[b]
Sub MAreas2()[/b]
    If ActiveSheet.FilterMode = True Then [color="blue"]           'Select cell in 3rd row first column[/color]
        ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Areas(3).Columns(1). _
Cells(1, 1).Select
[color="blue"]        '   *   Will tell you the actual row number of the third visible row [/color]
        MsgBox ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Areas(3).Rows(1).Row
    End If
[b]End Sub[/b]

/(/hững ghi chép về phương thức SpecialCells

SA_DQ

/(hông là gì!

SA_DQ

/(hông là gì!

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng