Cải thiện code trích lọc dữ liệu

[diemvuongvathuongde]

Chào các bác.
Em có dữ liệu và đoạn code để lọc ra một danh sách trong file đính kèm (Nhập tên lớp vào ô E1) dùng vòng lặp for. Xin các bác chỉ giúp cách khác có tốc độ nhanh hơn.

 

[transongngocquan]

bạn dùng advaned filter đi nhanh hơn nhiều

 

[SA_DQ]

Mình sẽ hướng dẫn bạn hoàn thành yêu cầu & phát triển ý tưởng bằng 2 bước:

(*) Hoàn thành đáp ứng đòi hỏi của bạn
(*) Phát triển, đi đến tự động hóa hoàn toàn việc lọc từ 1 comboBox
(Nếu bạn không thích bước sau thì có thể bỏ qua)

Bước (1) gồm các công đoạn sau:
* Chọn [E1]; Rà mũi chuột đến góc phải phía dưới cho đến khi xuất hiện chữ thập mảnh mai; Khi đó bạn bấm trái chuột, giữ & kéo xuống 1 ô;
(Kết quả phải là: tại E2 xuất hiên '8A2' - nếu tại E1 đang là '8A1')
* Thực hiện cách nào đó để 'E1' có nội dung như 'D1';
* Mở bộ thu macro: Vo menu Tool -> Macro -> Record New Macro . . .Trong CS (cửa sổ) Record Macro vừa xuất hiện, bạn nhập 'AdvFilter' vô ngăn Macro name & bấm chọn nút 'OK'
(Từ giờ trở đi, mọi hành động của bạn trên excel sẽ bị theo dõi sát sao & ghi lại hầu hết!)
* Ghi 1 macro lọc dữ liệu:
- Dùng chuột tô chọn các cột từ 'A' đến 'D';
- Vô menu Data -> Filter -> Advanced Filter. . .
- Trong ngăn Action bạn bấm chọn dòng thứ 2 (E2k3)
- (Trong ngăn List range nếu chưa có dòng Sheet1!$A:$D thì bạn làm sao cho nó có)
- Bạn bấm chuột vô dòng Criteria range & dùng chuột chọn 2 ô 'E1:E2'
- Tại dòng Copy to Bạn bấm vô đó & trên trang tính lại chọn vùng từ G1:H1'
- Bấm chọn nút 'OK'
- Để kết thúc ghi macro ta bấm vô nút 'STOP' có đâu đó trên trang tính của chúng ta; Nút này mới xuất hiện khi ta bật bộ thu macro)

Trong ngăn macro hiện bạn có thêm 1 đứa con tinh thần, nó có nội dung gần giống như sau:

[B]Sub AdvFilter()[/B]
    Columns("A:D").Select
    Range("D1").Activate
    Columns("A:D").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
        "E1:E2"), CopyToRange:=Range("G1:H1"), Unique:=False
[B]End Sub[/B]

* Chỉnh sửa macro: Bạn có thể chỉ cần giữ lại 3 dòng lệnh mà thôi, như sau:

Sub AdvFilter()
    Columns("A:D").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
        "E1:E2"), CopyToRange:=Range("G1:H1"), Unique:=False
End Sub

* Công đoạn gần cuối: Thử nghiệm macro:
Bạn có thể nhập vô 'E2'mỗi lần 1 tên lớp & cho chạy macro để chiêm nghiệm chiến tích của mình!

* Việc cuối là bạn vô cái macro cũ của bạn & sửa lại như sau:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$E$2" Then AdvFilter    
End Sub

Bước (2): Tự động hóa quá trình chọn lớp cho bộ lọc, gồm các công đoạn:
* Lập danh sách lớp duy nhứt tại E5:E21
- Bạn mở bộ thu macro lần nữa; Nhưng lần này để excel tự gán tên mặc định cho macro cũng được;
- Dùng chuột chọn cột 'D';
- Ta cũng thực hiện các bước để vô CS Advanced Filter & tại đây chúng ta:
Cũng chọn dòng thứ 2 trong ngăn Action;
trong ngăn List range có dòng Sheet1!$D:$D
Ngăn dưới liền kề có Sheet1!$D$1;
Ngăn kế tiếp là : Sheet1!$E$5
Nhưng khác 1 điều quan trọng, là bạn phải bấm vô nút chọn Unique Records only
Sau khi bấm 'OK' sẽ thấy kết quả hiện ra tại 'E6:E8'
* Gán tên cho 1 vùng:
Bạn tô chọn các ô từ E6:E21
Tô màu nền chúng vàng nhạt
(Vẫn những ô ấy được chọn) ta bấm vô ngăn trái nhứt của thanh công thức; Nhập vô đó tên 'DSLop' & bấm {ENTER} (Từ đây trở đi vùng này đã có 1 cái tên mới)
* Áp đặt Validation cho ô 'E2':
- Chọn ô này;
- Lại vô menu Data -> Validation. . . Trong tại dòng Allow của ngăn Validation criteria của CS Data Validation ta chọn dòng List
- Trong ngăn Sourse ta nhập =DSLop & bấm nút 'OK'

Nếu mọi việc suông sẻ, tại 'E2' ta có thể chọn bất kỳ dòng nào trong danh sách đổ xuống & excel đưa cho ta kết quả!

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