Áp dụng phương thức FIND() trên các cơ sở dữ liệu khác nhau

[SA_DQ]

1. Thống kê theo độ tuổi & phái tính của các đơn vị.​

Giả dụ chúng ta có CSDL (cơ sở dữ liệu) gồm 5 trường như bảng dẫn ra dưới đây:

MaNV | Ten | Nu | DVi | Tuoi || DVi | A | A | B | B | C | C | D | D
H1450|An|True|D|24|| DTuoi |Nam|Nu|Nam|Nu|Nam|Nu|Nam|Nu
J1150|Ba|False|A|54|| <30 |?|?|?|?|?|?|?|?
A8150|Ca|True|A|41|| <40 |?|?|?|?|?|?|?|?
M1205|Na|False|C|34|| <50 |?|?|?|?|?|?|?|?
A0150|La|True|C|19|| >=50 |?|?|?|?|?|?|?|?
M1250|Sa|False|C|34|| Sum ||?||?||?||?
B0050|Xa|True|C|19|||?||?||?||?|

Yêu cầu đề ra là thống kê xem từng đơn vị có bao nhiêu nam hay nữ ở các độ tuổi thanh niên, trung niên, cao tuổi,. . . . khác nhau. Kết quả sẽ phải trả lời bằng số liệu ở các ô có dấu chấm hỏi

Xin mời các bạn xem trong file kèm theo & macro sau:

Option Explicit:                                   Option Base 1
[B]Sub ThongKeTheoDoTuoiVaFaiTinh()[/B]
 Dim Rng As Range, sRng As Range
 Dim MyAdd As String
 Dim jJ As Byte, NS As Byte, Tuoi As Byte, Col As Byte, N_N As Byte
 
 Sheet1.Select:                        Col = [Ai1].End(xlToLeft).Column
 Set Rng = Range([d1], [d65500].End(xlUp))
 For jJ = 8 To Col Step 2 'Cot H'
   ReDim NamNu(4, 2) As Byte
   Set sRng = Rng.Find(Cells(1, jJ).Value, , xlFormulas, xlWhole)
   If Not sRng Is Nothing Then
      MyAdd = sRng.Address
      Do
         NS = sRng.Offset(, 1).Value
         If NS <= 18 Then MsgBox "Tuoi Vi Thành Nien", , "GPE"
         Tuoi = Switch(NS < 30, 1, NS < 40, 2, NS < 50, 3, NS >= 50, 4)
         If sRng.Offset(, -1).Value Then N_N = 2 Else N_N = 1
         NamNu(Tuoi, N_N) = 1 + NamNu(Tuoi, N_N)
         Set sRng = Rng.FindNext(sRng)
      Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
      For NS = 3 To 6
         Cells(NS, jJ).Value = NamNu(NS - 2, 1)
         Cells(NS, jJ + 1).Value = NamNu(NS - 2, 2)
      Next NS
   End If
 Next jJ
[B]End Sub
[/B]

 

[SA_DQ]

(2) Tìm Tên & mã của các nhân viên của các công ti​

Ví dụ CSDL của chúng ta những khách hàng khác nhau ở các công ty đối tác, được trích ra & chứa trong 3 trường theo như CSDL dưới đây:

|A|B|C|D|E|F|G|H|I|J|K
1 | MaNV | Mã CT | TenNV || MaCT | Val | Val | Val | Val | Val | Val 2 |123A|B|An|| TenNV |?|?|?|?|?|?
3 |456B|A|Ba|||?|?|?|?|?|?
4 |143A|C|Anh|||?|?|?|?|?|?
5 |406B|D|By|||?|?|?|?|?|?
6 |923C|B|Cy|||?|?|?|?|?|?
7 |006N|A|Na|||?|?|?|?|?|?
8 |123D|B|Dy|| MaNV |??|??|??|??|??|??
9 |006K|A|Ka|||??|??|??|??|??|??
10 |140M|C|My|||??|??|??|??|??|??
11 |406V|D|Vy|||??|??|??|??|??|??
12 |993S|B|Sy|||??|??|??|??|??|??
13 |006T|A|Ty|||??|??|??|??|??|??

Tại vúng các ô có từ Val người ta đã áp đặt hộp chọn Validation để chọn mã 1 trong các công ti đối tác;
Liền ngay sau đó macro sẽ tìm tên các nhân viên công ti đó điền ngay fía dưới cùng cột với hộp Validation tương ứng vừa chọn.
Và tương tự, mã các nhân viên sẽ được điền thay chổ của các cặp đầu hỏi (dòng 8 trở đi)

Macro sự kiện khi ta chọn trong hộp Validation có nội dung sau:

Option Explicit
[B]Private Sub Worksheet_Change(ByVal Target As Range)[/B]
 If Not Intersect(Target, [F2].Resize(, 6)) Is Nothing Then
   Dim Rng As Range, sRng As Range, MyAdd As String, Col As Byte
 
   Target.Offset(1).Resize(18).ClearContents
   Set Rng = Range([B2], [B65500].End(xlUp)):            Col = Target.Column
   Set sRng = Rng.Find(Target.Value, , xlFormulas, xlWhole)
   If Not sRng Is Nothing Then
      MyAdd = sRng.Address
      Do
         Cells(11, Col).End(xlUp).Offset(1).Value = sRng.Offset(, 1).Value
         If Cells(11, Col).Value = "" Then
            Cells(11, Col).Value = sRng.Offset(, -1).Value
         Else
            Cells(35, Col).End(xlUp).Offset(1).Value = sRng.Offset(, -1).Value
         End If
         Set sRng = Rng.FindNext(sRng)
      Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
   End If
 End If
[B]End Sub[/B]

 

[SA_DQ]

Xem xét đến tham số LookIn liên quan đến sự tăng tốc độ tìm kiếm

(3) Lựa chọn xlFormulas hay xlValues​

Trong fương thức tìm kiếm của excel có rất nhiều tham số mà ta cần cung cấp hay mặc định nếu ta không làm thế.

Chúng ta sẽ nghiên cứu trong bài này là tham số LookIn khi tìm kiếm dữ liệu dạng value trong 1 CSDL lớn (cỡ vạn dòng)

Nhiệm vụ của 1 bài toàn cụ thể có thể là tìm & liệt kê hồ sơ có liên quan (như fái tính, chức vụ, năm sinh & tình trạng gia đình, . . . ) của tất cả các mã các nhân viên có tên là 'Hồng' trong 1 CSDL 1 ngàn người.

Để thực hiện nhiệm vụ đề ra chúng ta đã có macro sau:

Option Explicit
[B]Sub xlFormulaOrxlValues()[/B]
 Dim Sh As Worksheet, Rng As Range, sRng As Range, Cls As Range
 Dim MyAdd As String, Timer_ As Double
 
 Timer_ = Timer:                       Sheets("SS").Select
 Set Sh = Sheets("AA"):                Range("C3:K25").ClearContents
 Set Rng = Sh.Range(Sh.[B1], Sh.[B65500].End(xlUp))
 For Each Cls In Range([B3], [B65500].End(xlUp))
[B]7[/B]   Set sRng = Rng.Find(Cls.Value, , xlValues, xlWhole) [COLOR="Red"]'<=|'[/COLOR]
   If Not sRng Is Nothing Then
      MyAdd = sRng.Address
      Do
         Cells(Cls.Row, "L").End(xlToLeft).Offset(, 1).Value = sRng.Offset(1).Value
         Set sRng = Rng.FindNext(sRng)
      Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
   End If
 Next Cls
 [L65500].End(xlUp).Offset(2).Value = Timer - Timer_
[B]End Sub[/B]

Nội dung macro này là:

Duyệt toàn bộ các mã đang có tại cột 'B' của trang tính 'SS' theo từng fần tử;
Với mỗi fần tử cần thực hiện tìm mã fần tử đó có trong gần 2 vạn số liệu chứa trong cột 'B' của trang tính 'AA', hơn nữa, trong đó có thể có dữ liệu trùng lắp.

Sau khi xong nhiệm vụ, macro sẽ ghi lại thời gian làm việc tại cột 'L' của 'SS'

Với nhiệm vụ nặng nề & vẻ vang như vậy thường macro làm việc khoảng > 0.3 giây;

Nhưng nếu ta thay tham số xlValue trong dòng lệnh có đánh số nêu trên thành xlFormulas Tốc độ macro sẽ được rút ngăn đi gấp 1.5 lần. (Thay vì thời gian đó, macro chỉ dùng suýt xoát 0.2 gy mà thôi)

Các bạn có thể nói: " Ngồi hàng giờ đồng hồ uống li càfê còn không chết chót ai, huống gì ba thư lẻ tẻ đó"; Nhưng vấn đề là ở chổ, chúng ta mớí xét CSDL chỉ 1 vài trường, nhưng trong thực tiển, CSDL thường có vài ba chục trường thì chuyện ấy sẽ khác ngay, có khi chỉ vì không chú í chuyện cải thiện tốc độ, làm cho CSDL ta đơ ra & không chịu chạy luôn!

(Mời các bạn xem thêm trong file)

 

[SA_DQ]

(4) Tìm kiếm dữ liệu kiểu ngày tháng​

Chúng ta xét đến 1 file quản lý xuất nhập thuốc hàng ngày. Yêu cầu đề ra là:
Khi đã có số liệu tồn đầu tháng & số liệu nhập xuất các ngày trong tháng, bằng macro ta có thể tìm & lập danh sách thuốc nhập xuất của 1 ngày nào đó với 4 cột dữ liệu như sau: Tồn đầu ngày, Nhập trong ngày (chỉ 2 loại nhập), xuất trong ngày (cũng 2 loại) & tồn cuối ngày.

Trang lưu trữ dữ liệu là 'KT 11' & trang thể hiện số liệu báo cáo là 'In'
Ngày tháng xuất nhập hàng thể hiện tại vùng từ 'R5' cho đến 'EK5'; Hơn nữa toàn vùng đang được định dạng kiểu Custom "Ngày "dd
Nhưng ngày cần tìm kiếm & thể hiện trong trang báo cáo ('In') lại được tổ hợp lại từ 3 hộp Validation (Năm, tháng & ngày) bằng hàm DATE() ở ô 'D3' & đang được định dạng cũng kiểu Custom nhưng là: "Ngày "dd " tháng "mm" năm "yyyy" ."

Sao tôi lại fải đi nhắc lại về vấn đề định dạng của các ô dữ liệu chứa ngày tháng năm này? Vấn đề ở chổ áp dụng fương thức FIND() chỉ nên cho kiểu định dạng thông dụng mà bọn Mẽo hay xài mà thôi, đó là định dạng "mm/DD/yyyy"

Các bạn xem kỹ trong vùng giữa các dòng lệnh được đính số & trong file đính kèm sẽ rõ hơn.

(Trong file, để có bảng báo cáo ngày nào trong tháng 11 này, chúng ta chọn ngày đó trong hộp Validation [N2]; Liền ngay sau đó, macro sự kiện sẽ giúp ta thể hiện số liệu trên trang tính này)

Option Explicit
[B]Private Sub Worksheet_Change(ByVal Target As Range)[/B] If Not Intersect(Target, [N2]) Is Nothing Then
   Dim Dat As Date, WF As Object
   Dim Sh As Worksheet, Rng As Range, sRng As Range, Clls As Range
   Dim Ton As Double, Nhap As Double, Xuat As Double
   Dim DCol As Byte, wW As Byte, jJ As Long
   Const Nh As Byte = 18:                    Const Xt As Byte = 80
   Const NK As Byte = 49:                    Const XK As Byte = 111
   
   Dat = [d3].Value:                         Set Sh = Sheets("KT 11")
   Set Rng = Sh.Range(Sh.[q5], Sh.[iv5].End(xlToLeft))
1   Rng.NumberFormat = "mm/dd/yyyy"
   Set sRng = Rng.Find(Format(Dat, "mm/dd/yyyy"), , xlValues, xlWhole)
   If Not sRng Is Nothing Then DCol = sRng.Column
4   Rng.NumberFormat = """Ngày ""dd"
   Range("B8:L55").ClearContents:            Range("B57:L555").ClearContents
   Set WF = Application.WorksheetFunction
   [A8].Resize(45).EntireRow.Hidden = False
   For jJ = 8 To Sh.[B65500].End(xlUp).Row
      Set Rng = Sh.Cells(jJ, DCol):          Ton = Sh.Cells(jJ, "E").Value
      If jJ > 56 Then Application.ScreenUpdating = False
      If DCol > 18 Then
         Set Clls = Sh.Cells(jJ, Nh).Resize(, DCol - Nh)
      Else
         Set Clls = Sh.Cells(jJ, Nh)
      End If
      Nhap = WF.Sum(Clls) + WF.Sum(Clls.Offset(, 31))
      For wW = 1 To 3
         Set Rng = Union(Rng, Sh.Cells(jJ, DCol + wW * 31))
      Next wW
      If WF.Sum(Rng) > 0 Then
         If jJ < 56 Then Set sRng = [B56] Else Set sRng = [B567]
         With sRng.End(xlUp).Offset(1)
            .Value = Sh.Cells(jJ, "B").Value
            .Offset(, 3).Value = Ton + Nhap
            .Offset(, 4).Value = Rng.Value
            .Offset(, 5).Value = Rng.Offset(, 31).Value
            .Offset(, 6).Value = Rng.Offset(, 62).Value
            .Offset(, 7).Value = Rng.Offset(, 93).Value
         End With
      End If
   Next jJ
   Range([B55], [B55].End(xlUp).Offset(2)).EntireRow.Hidden = True
 End If
[B]End Sub[/B]

 

[SA_DQ]

(4a) Tìm ngày gần nhất so với ngày cho trước.​

(Bài này khác hơn với #4 ở trên 1 chút. Bài 4 là ta đi tìm 1 ngày biết chắc chắn là nó có trong danh sách. Còn giờ đây, nhiệm vụ của ta là tìm 1 ngày gần nhất so với ngày cần tìm trong 1 danh sách để tìm.)

Để cụ thể hơn, ta xét đến chương trình quản lý nhập xuất tòn của 1 CT (công ti nho nhỏ) mua bán tạp fẩm; Chúng ta có 4 trang tính gồm Nhap, Xuat, Ton & XNT (Thực ra Nhap & Xuat chung cũng được). Ta quan tâm nhất trong đó là trang 'Ton', có cấu trúc như sau:

Ma|Ten|DVT| 1/1/2010 | 7/1/2010 | 9/16/2010 | 11/1/2010 |. .
NC01|Noi com|C|201|210|200|1210|
DT72|Dien thoai|C|10|200|160|110|
TV07|Ti vi|C|10|21|29|12|
NU00|Nuoc uong|T|110|120|160|120|
|. . ||. . .|||. .|

Trong đó các trường tô đậm là ngày kiểm kê hàng tồn của CT;

Nhiệm vụ đề ra là ta tìm xem từ 1 ngày nào đó (như 10/20/2010) đến ngày kiểm kê gần nhất trước đó CT đã nhập xuất bao nhiêu hàng & đang tồn đến thời điểm đó là bao nhiêu hàng.

Nhiệm vụ đề ra được hoàn thành bỡi 1 macro có trong file đính kèm, được trích ra như dưới đây:

Option Explicit
Dim Sh As Worksheet
[B]Sub NhapXuatTon()[/B]
 Dim WF, Rng As Range, sRng As Range, Cls As Range, Sh0 As Worksheet
 Dim Rws As Long, Jj As Long, Col As Byte:               Dim Dat As Date
 
 Set Sh = Sheets("Ton"):                                 Sheets("NXT").Select
 Set Rng = Sh.Range(Sh.[e1], Sh.[iv1].End(xlToLeft))
 Set WF = Application.WorksheetFunction:                 Dat = [C2].Value
 Set sRng = Rng.Find([C2].Value, , xlFormulas, xlWhole)
 'Tính Ton Dau Ky:'
 If sRng Is Nothing Then
[B]6 [/B]For Jj = 1 To 367
      Set sRng = Rng.Find(Dat - Jj)
      If Not sRng Is Nothing Then
         Dat = Dat - Jj:                                 Exit For
[B]10 [/B]     End If
   Next Jj
   If Jj > 366 Then
      MsgBox "Chi Thong Ke Trong Nam", , "Tam Biet":     Exit Sub
   End If
   CopyTon sRng.Column
   For Jj = 1 To 2
      Set Sh0 = Sheets(Switch(Jj = 1, "Nhap", Jj = 2, "Xuat"))
      Sh0.[iA2].Value = ">=" & Format$(Dat)
      Sh0.[ib2].Value = "<=" & Format$([C2].Value - 1)
      Rws = Sh0.[B65500].End(xlUp).Row
      Sh0.[B1].Resize(Rws, 4).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
         Sh0.Range("iA1:iB2"), CopyToRange:=Sh0.[iA4].Resize(, 4), Unique:=False
      For Each Cls In Range("B5:B" & [B65500].End(xlUp).Row)
         With Cls.Offset(, 3)
            If Jj = 1 Then
               .Value = .Value + _
                  WF.SumIf(Sh0.[iA4].CurrentRegion.Offset(, 1), Cls.Value, Sh0.[iD4])
            Else
               .Value = .Value - _
                  WF.SumIf(Sh0.[iA4].CurrentRegion.Offset(, 1), Cls.Value, Sh0.[iD4])
            End If
         End With
      Next Cls
   Next Jj
 Else
12 Col = sRng.Column
   CopyTon Col
 End If
2 'Nhap & Xuat Trong Kì:'
 For Jj = 1 To 2
   Set Sh0 = Sheets(Switch(Jj = 1, "Nhap", Jj = 2, "Xuat"))
   Sh0.[iA2].Value = ">=" & Format$([C2].Value)
   Sh0.[ib2].Value = "<=" & Format$([C3].Value)
   Rws = Sh0.[B65500].End(xlUp).Row
   Sh0.[B1].Resize(Rws, 4).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
      Sh0.Range("iA1:iB2"), CopyToRange:=Sh0.[iA4].Resize(, 4), Unique:=False
   Rws = [B65500].End(xlUp).Row
   [f5].Resize(Rws).Offset(, Jj - 1).ClearContents
   For Each Cls In [b5].Resize(Rws)
      With Cls.Offset(, 3 + Jj)
         .Value = WF.SumIf(Sh0.[iA4].CurrentRegion.Offset(, 1), Cls.Value, Sh0.[iD4])
      End With
   Next Cls
 Next Jj
[B]End Sub[/B]

 

[SA_DQ]

.​

(4b) Tìm dòng đầu tiên & dòng cuối có dữ liệu của năm ở 1 CSDL nhiều năm.​

Giả dụ ta có danh sách liệt kê đơn giá bán thay đổi trong các ngày của nhiều năm; CSDL này có hàng vạn dòng, mà trong bảng dưới đây, ta chỉ thể hiện chỉ vài dòng thuộc cột 'A' , như sau:

A|B|C|D|E|F
DATE||Năm|Address||Address_1
09/30/2011||11|SA$2:SA$5||$A$2:$A$7
10/13/2011||12|SA$8:SA$189||$A$8:$A$190
10/13/2011||13|SA$191:SA$919||$A$191:$A$920
11/15/2011||14|SA$921:SA$1649||$A$921:$A$1650
12/30/2011||15|SA$1651:SA$2379||$A$1651:$A$2380
12/30/2011||16| . || .
12/30/2011||17| . || .
01/30/2012||18| . || .
02/03/2012||. .| . || .
. . .|| . . | . || .

Thêm vào đó, tại cột 'C' bắt đầu từ [C2] ta liệt kê 2 chữ số cuối của năm.
Nhiệm vụ đề ra là ta viết macro để xác định địa chỉ đầu & cuói của năm tương ứng vô cột bên fải liền kề.

Macro dưới đây sẽ cho ra kết quả được ghi trên cột 'D' tương ứng

Option Explicit
[B]Sub FindAddress()[/B]
 Dim Cls As Range, Rng As Range, sRng As Range, fRg As Range, lRg As Range
 Dim Dat As Date
 Dim jJ As Integer, SoNgay As Integer
 Dim MyAdd As String
 
 Set Rng = Range([A1], [A65500].End(xlUp))
 For Each Cls In Range([C2], [C65500].End(xlUp))
   Dat = DateSerial(2000 + Cls.Value, 1, 1)
   SoNgay = DateSerial(2001 + Cls.Value, 1, 1) - Dat
   For jJ = 0 To SoNgay
      Set sRng = Rng.Find(Dat + jJ, , xlFormulas, xlWhole)
      If Not sRng Is Nothing Then
         Set fRg = sRng
         Exit For
      End If
   Next jJ
   Dat = Dat + SoNgay
   For jJ = 1 To SoNgay
      Set sRng = Rng.Find(Dat - jJ)
      If Not sRng Is Nothing Then
         
4         Set lRg = sRng
         Exit For
      End If
   Next jJ
   If Not fRg Is Nothing And Not lRg Is Nothing Then
9      Cls.Offset(, 1).Value = Range(fRg, lRg).Address
      Set fRg = Nothing:         Set lRg = Nothing
   End If
 Next Cls
[B]End Sub[/B]

Nhưng macro này đưa ra kết quả chưa thực sự như chúng ta mong muốn
Ví dụ trong năm 2011 ngày 30/12 có tới 3 lần đổi đơn giá & quan trọng hơn đó là macro chưa đưa ra đơn giá cuối cùng trong năm (ở dòng 7), mà là đơn giá đầu tiên của ngày cuối năm đó.

Để có kết quả như ở cột 'F', chúng ta chỉ cần thêm trước dòng lệnh có đánh số 4 câu lệnh

Set sRng = Rng.FindPrevious(sRng)

( Để có dữ liệu trên cột 'F' như bảng giả lập, ta sửa con số 1 trong dòng lệnh 9 thành con số 3)

(Bạn nào còn lấn cấn điều gì, ta xem thêm trong file, nha)

 

[SA_DQ]

(5) Tìm kiếm dữ liệu trong vùng có ô bị ẩn.​

Giả dụ ta có bảng DL (dữ liệu) là danh sách nhân viên cơ quan, như sau:

1 | Ten |
2 |An|
3 |Anh|
4 |Án|
5 |Ánh|
6 |An|
7 |Tang|
8 |Áng|
9 |Ánh|
10 |Nan|
11 |Phan|Can
12 |Cán|Quan
13 |Thanh|Quán
17 ||

Các chữ số bên trái của bảng cho ta biết số thứ tự dòng của trang tính. Hơn nữa, ta biết trong vùng chứa DL có 3 dòng ẩn đi. Mà DL trong 3 ô ẩn đó được sao chép ra cột bên fải liền kề với 3 dòng trên chúng

Để tìm kiếm DL trong cột [Ten] , trước tiên ta cần xác định vùng có chứa DL của cột này.

Ở đây mình muốn lưu ý với các bạn một điều về xác định vùng có DL mà trong đó có các ô bị ẩn, như sau

Nếu ta dùng phương thức End() như macro sau thì sẽ sai lầm nghiêm trọng với DL trên:

Option Explicit
[B]Sub TimDongCuoi()[/B]
 Dim Rng As Range:                    Dim eRw As Long
 
 Set Rng = Range([A1], [A65500].End(xlUp))
 MsgBox Rng.Address
[B]End Sub[/B]

Cho nên ta phải xoay hướng khác để tìm dòng cuối có DL, như dưới đây ta sẽ thấy.
Macro đó viết ra để tìm những người có các chữ cái "án" chứa trong tên:

Option Explicit
[B]Sub TimDongAn()[/B]
 Dim Rng As Range, sRng As Range, hRg As Range
 Dim eRw As Long, MyAdd As String
 
 Set Rng = Range([A1], [A65500].End(xlUp))
 MsgBox Rng.Address
 eRw = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, _
   SearchDirection:=xlPrevious).Row
 Set Rng = [A1].Resize(eRw)
[B]7[/B] Set sRng = Rng.Find("án", , xlFormulas, xlPart)
 If Not sRng Is Nothing Then
   MyAdd = sRng.Address
   Do
      MsgBox sRng.Value, , Rng.Address
      Set sRng = Rng.FindNext(sRng)
   Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
 End If
[B]End Sub[/B]

Tuy cột [Ten] là DL nhập, không fải do công thức sinh ra, nhưng ta cứ buộc fải xài tham số xlFormulas ; Vì nếu xài tham số xlValues kết quả sẽ khác đi nhiều. Đó là không tìm ra người tên 'Quán' trong ô bị ẩn đi trước đó.

 

[SA_DQ]

(6) Sử dụng fương thức FIND() trong hàm tự tạo.​

Giả dụ chúng ta có 1 danh sách khách hàng mới & tiềm năng (ở cột 'A') & danh sách khách hàng cũ (Ở cột 'D'); Hơn nữa trong danh sách mới có thế có chứa 1 fần (chứ không fải toàn thể) địa chỉ của khách hàng cũ (Như [A11] & [D12]).

Nhiệm vụ đề ra là ta cần viết hàm tự tạo tìm xem địa chỉ của các thượng đế mới này có trong thành fần của danh sách thượng đế cũ hay không.

Hàm người dùng có các câu lênh như sau:

Option Explicit
Function gpeFIND(fValue As String, rVung As Range)
 Dim sRng As Range
 
 Set sRng = rVung.Find(fValue, , xlFormulas, xlPart)
 If Not sRng Is Nothing Then
   gpeFIND = sRng.Value                      '<=|'
 Else
   gpeFIND = "Nothing"
 End If
End Function

Các bạn xem cú fáp hàm ở cột 'G' trong file kèm theo.

Chúc cuối tuần vui vẽ!

 

[SA_DQ]

(6a) FIND() trong hàm tự tạo để giảm số lần lặp​

Giả dụ ta có danh sách giáo viên giảng dạy gần 70 lớp của một trường cấp I & II được trích dẫn như sau:

TT | HoTen GV | Dạy lớp
01|Hồ Na|1A1
02|Hồ Na|1A2
03|Hồ Na|1A7
04|Hồ Na|1A9
05|Vy Hà|2A2
..|:angel:|. .
34|Lê Vy|5A5
35|Lê Vy|5A6
36|Lê Vy|5A7
37|Lê Vy|5A8
38|Lê Vy|5A9
. .|. . .|. .

Nhiệm vụ đề ra là thống kê các lớp mà giáo viêncụ thể nào đó, như Lê Vy giảng dạy ở các lớp nào;

Để thực hiện việc đó ta có thể lập hàm tự tạo như sau:

Option Explicit
[B]Function LopDay(Ten As String, Vung As Range) As String[/B]
    Dim Cll As Range
    
    Set Cll = Vung.Find(Ten, , xlFormulas, xlWhole)
    If Cll Is Nothing Then
        LopDay = "Nothing"
    Else
        Set Vung = Range(Cll, Vung.Cells(Vung.Count))
[COLOR="Blue"]'        MsgBox Vung.Address  '[/COLOR]
        For Each Cll In Vung
            If Cll.Value = Ten Then LopDay = LopDay & Cll.Offset(, 1).Value & ", "
        Next Cll
    End If
    LopDay = Left(LopDay, Len(LopDay) - 2)
[B]End Function[/B]

Ta sử dụng cú fáp sau để hàm tự tạo cho ra kết quả: =LopDay(B38,B4:B67)

Trong công thức đó, [B38] trên trang tính có tên là 'Lê Vy' trong danh sách giáo viên được liệt kê trên cột 'B' từ dòng 4 đến dòng 67

Áp dụng fương thức FIND() cho giáo viên Lê Vy, ta đã có thể bỏ qua nữa đầu của danh sách toàn bộ các giáo viên.

 

[SA_DQ]

(6B) Không sử dụng được fương thức FINDNEXT() trong hàm tự tạo, nhưng. . . ​

Nếu với cơ sở dữ liệu như bài trên liền kề, ta viết hàm tự tạo có nội dung như sau:

Option Explicit
[B]Function DayCacLop(Ten As String, VungTen As Range) As String[/B]
 Dim MyAdd As String, sRng As Range
 On Error GoTo LoiCT
  
1 Set sRng = VungTen.Find(Ten, , xlFormulas, xlWhole)
 If sRng Is Nothing Then
3    DayCacLop = "Nothing":              Exit Function
 Else
5    MyAdd = sRng.Address
    Do
7        DayCacLop = DayCacLop & sRng.Offset(, 1).Value & ", "
9        Set sRng = VungTen.FindNext(sRng)
    Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
 End If
Err_:               Exit Function
LoiCT:
    DayCacLop = Erl & ": " & Error:              Resume Err_
[B]End Function[/B]

Thêm khác hơn so với bài đó, ta đem vùng cột 'B' chứa danh sách giáo viên toàn trường (các ô 'B1:B70') gán với tên 'GVien'

Nếu trong cửa sổ VBE, ta kiểm tra lỗi bằng nhấn nút Compile VBAProject thì chương trình sẽ cho chúng ta biết là chúng ta không mắc fải lỗi lầm nào.

Nhưng khi chọn 1 ô trống trên trang tính & nhập cú fáp =DayCacLop(B15,GVien)
(Ở đây [B15] là tên 1 giáo viên nào đó, như Lê Hà,. . .) & ta nhấn nút {ENTER}

Thì trớ trêu, ta nhận được kết quả không mong muốn từ hàm: 9: Object variable or With block variable not set

Theo như nội dung hàm mà chúng ta đã viết thì chương trình gặp fải lỗi tại dòng lệnh được đánh số 9 & đoạn văn sau là thông tin về nội dung lỗi mà chúng ta & nó gặp fải
Thực ra nó báo cho ta biết rằng, chúng ta không thể dùng fương thức FINNEXT() trong hàm tự tạo để tìm ra các kết quả cần tìm;

/)/hưng điều ngạc nhiên mà tôi muốn trình bày với các bạn còn đang ở fía trước; Đó là:

Nếu trong cửa sổ Immediate của trình VBE, ta nhập cú fáp sau:
?DayCacLop(Sheet2.range("B47"),Sheet2.Range("B1:B70"))

Thì cửa số này cho ta kết quả đúng cái mà ta mong mõi; Đó là 6A6, 6A7, 6A8, 6A9, 6A1, đúng như ta xài hàm LopDay(. . ,. . .) của bài (6A) trước đây đã biết.


:wall: :wall: :wall:

 

[SA_DQ]

(7) Áp dụng f ương thức FIND() với các ô trộn. ​

Giả dụ chúng ta đã thiết lập 1 CSDL (cơ sở dữ liệu) của các gia đình, như sau:

A|B
HoTen | Quan Hệ Đỗ Chi |
Lê Zy|Vợ
Đỗ My|Con
Đỗ Si|Em
Đỗ Ty|Cháu
Đỗ Vy|Chị
Hà An |
Đỗ Thi|Vợ
Hà Anh|Con
Hà Ân|Cháu
Hà Ăn|Em
Lê Anh |
Hà My|Vợ
Lê An|Con
Lê Ân|Cô
Lê Na|Chị

Trong đó, các chủ hộ được tô đậm & trớ trêu thay, người ta còn trộn ô chứa tên chủ hộ với ô bên fải liền kề (cho mỹ quan của người tạo ra CSDL, cũng là nhằm mục đích tách bạch với những người trong hộ & với những hộ khác).

Tuy nhiên khi áp dụng fương thức FIND() với CSDL này, chúng ta sẽ gặp trỡ ngại.
Trỡ ngại đó sẽ thể hiện khi ta chạy macro có nội dung sau:

Option Explicit
[B]Sub FindMergeCells()[/B]
 Dim Rng As Range, sRng As Range
 Dim Jj As Byte, eRw As Long
 
 eRw = [A1].CurrentRegion.Rows.Count
 For Jj = 1 To 2
    Set Rng = [A1].Resize(eRw, Jj)
    Set sRng = Rng.Find("Hà An", , xlFormulas, xlWhole)
    If sRng Is Nothing Then
        MsgBox "Nothing", , Jj
    Else
        MsgBox sRng.Address
    End If
 Next Jj
[B]End Sub[/B]

(Trỡ ngại đó như thế nào, mời các bạn lập CSDL tương tự & chạy thử macro để chiêm nghiệm các kết quả do hộp thoại đưa lại.

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