Có code lọc dữ liệu nhanh hơn không ?

Liên hệ QC

legiangnt

Thành viên chính thức
Tham gia
12/8/08
Bài viết
63
Được thích
8
Em có sử dụng code của các bác trên diễn đàn. Khi áp dụng với dữ liệu của em (khoảng 800 dòng) thì chạy rất chậm. Nhờ các bác giúp đỡ để code lọc nhanh hơn. Xin cảm ơn các bác !
 

File đính kèm

Code như vầy là nhanh lắm rồi đó bạn. Còn tình trạng như bạn nói thì có thể là do cấu hình máy của bạn yếu quá không thể chạy nổi file Excel này. Ở máy mình thì nó tính chưa tới 1 giây với dữ liệu 10,000 dòng. Vậy bạn thử lại trên máy khác xem. Thêm code xử lý việc xóa dữ liệu ở ô B2 để nó trở lại bình thường.
PHP:
Private Sub Worksheet_Change(ByVal Target As Range) Application.DisplayAlerts = False If Target.Address = "$B$2" Then     Set DS = [A4].CurrentRegion     If Target = "" Then ActiveSheet.ShowAllData: Exit Sub     DS.AdvancedFilter Action:=1, CriteriaRange:=Range("B1:B2") End If End Sub
Thân.
 
Lần chỉnh sửa cuối:
Upvote 0
Em có sử dụng code của các bác trên diễn đàn. Khi áp dụng với dữ liệu của em (khoảng 800 dòng) thì chạy rất chậm. Nhờ các bác giúp đỡ để code lọc nhanh hơn. Xin cảm ơn các bác !
Bạn bỏ hết công thức đi là file chạy nhanh liền... (Đã VBA sao lại cần công thức)
 
Upvote 0
Cám ơn các bác, nhất là bác Po_Pikachu , đã giải quyết được tốc độ. File của em chỉ chạy chậm khi hiện lại các dữ liệu. Cho em hỏi khi thêm Unprotect và Protect thì thêm vào code thế nào để lọc hay hiện dữ liệu đều khóa lại khi hoàn thành.
 
Upvote 0
Cám ơn các bác, nhất là bác Po_Pikachu , đã giải quyết được tốc độ. File của em chỉ chạy chậm khi hiện lại các dữ liệu. Cho em hỏi khi thêm Unprotect và Protect thì thêm vào code thế nào để lọc hay hiện dữ liệu đều khóa lại khi hoàn thành.
Mã:
[COLOR=#000000][COLOR=#007700]Private [/COLOR][COLOR=#0000BB]Sub Worksheet_Change[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000BB]ByVal Target [/COLOR][COLOR=#007700]As [/COLOR][COLOR=#0000BB]Range[/COLOR][COLOR=#007700])
[/COLOR][COLOR=#0000BB]Application[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000BB]DisplayAlerts [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000BB]False
[/COLOR][COLOR=#007700]If [/COLOR][COLOR=#0000BB]Target[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000BB]Address [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#DD0000]"$B$2" [/COLOR][COLOR=#0000BB]Then
UnProtectSh
    Set DS [/COLOR][COLOR=#007700]= [[/COLOR][COLOR=#0000BB]A4[/COLOR][COLOR=#007700]].[/COLOR][COLOR=#0000BB]CurrentRegion
    [/COLOR][COLOR=#007700]If [/COLOR][COLOR=#0000BB]Target [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#DD0000]"" [/COLOR][COLOR=#0000BB]Then ActiveSheet[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000BB]ShowAllData[/COLOR][COLOR=#007700]: Exit [/COLOR][COLOR=#0000BB]Sub
    DS[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000BB]AdvancedFilter Action[/COLOR][COLOR=#007700]:=[/COLOR][COLOR=#0000BB]1[/COLOR][COLOR=#007700], [/COLOR][COLOR=#0000BB]CriteriaRange[/COLOR][COLOR=#007700]:=[/COLOR][COLOR=#0000BB]Range[/COLOR][COLOR=#007700]([/COLOR][COLOR=#DD0000]"B1:B2"[/COLOR][COLOR=#007700])
[/COLOR][COLOR=#0000BB]End [/COLOR][COLOR=#007700]If
[/COLOR][/COLOR][COLOR=#000000][COLOR=#0000BB]ProtectSh[/COLOR][/COLOR]
[COLOR=#000000][COLOR=#007700][/COLOR][COLOR=#0000BB]End Sub  

Sub ProtectSh()
...
end Sub

[/COLOR][/COLOR]
 
Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
Vậy thì bạn phải Lock tất cả các cell chừa lại hai ô B1 và B2. Bạn nhấn Ctrl + A, nhấn phải chuột chọn Format Cells -> tab Protection -> chọn Lock. Tiếp theo chọn ô B1:B2, vào Format Cells/Protection/ bỏ chọn Lock. Rồi sữa lại code như vầy là được.
PHP:
Private Sub Worksheet_Change(ByVal Target As Range) Dim pass As String Application.DisplayAlerts = False pass = "Password" If Target.Address = "$B$2" Then     ActiveSheet.Unprotect pass     Set DS = [A4].CurrentRegion     If Target = "" Then ActiveSheet.ShowAllData: ActiveSheet.Protect pass: Exit Sub     DS.AdvancedFilter Action:=1, CriteriaRange:=Range("B1:B2") End If ActiveSheet.Protect pass End Sub
File: http://www.mediafire.com/?ylgnigzfmyq Thân.
 
Lần chỉnh sửa cuối:
Upvote 0
Em có sử dụng code của các bác trên diễn đàn. Khi áp dụng với dữ liệu của em (khoảng 800 dòng) thì chạy rất chậm. Nhờ các bác giúp đỡ để code lọc nhanh hơn. Xin cảm ơn các bác !
Bạn chỉnh lại code thế này thì chạy cực nhanh luôn
PHP:
 Private Sub Worksheet_Change(ByVal Target As Range)
Application.DisplayAlerts = False
  If Target.Address = "$B$1" Or Target.Address = "$B$2" Then
    On Error Resume Next
    ActiveSheet.ShowAllData
    Set DS = [A4].CurrentRegion
    DS.AdvancedFilter Action:=1, CriteriaRange:=Range("B1:B2")
  End If
End Sub

  1. Khi mỗi lần thay đổi B1:B2 AdvancedFilter bị chậm là do trong vùng có những cells bị ẩn do AdvancedFilter lần trước Action:=xlFilterInPlace
  2. Vậy ShowAllData trước khi AdvancedFilter thì tốc độ lọc vèo vèo ngay thôi mà
 
Upvote 0
Chạy vèo vèo
------------
 
Upvote 0
Application.DisplayAlerts = False

If Target.Address = "$B$1" Or Target.Address = "$B$2" Then
On Error Resume Next
ActiveSheet.ShowAllData
Set DS = [A4].CurrentRegion
DS.AdvancedFilter Action:=1, CriteriaRange:=Range("B1:B2")
End If
End Sub

Anh Boyxin ơi
Có phải phần bôi đậm trên không ghi hiểu Target = "" không?

Tại sao Set DS lại là A4 mà không phải là C4...

Action bằng 1 hiểu là chỉ lấy duy nhất không?


Cám ơn anh
 
Upvote 0
Anh Boyxin ơi
If Target.Address = "$B$1" Or Target.Address = "$B$2" Then
Có phải phần bôi đậm trên không ghi hiểu Target = "" không?
Chính xác: vì Target.Address ý nói là địa chỉ của ô điều kiện chạy code (làm gì có ô nào trong Excel có địa chỉ là "" )

Action bằng 1 hiểu là chỉ lấy duy nhất không?
Không phải vậy
Action = 1 là AdvancedFilter tại chỗ, dòng nào không thỏa điều kiện thì ẩn đi

Tại sao Set DS lại là A4 mà không phải là C4...
Trong vùng [A4:F805]
Theo như trong File đính kèm ở bài #1: chọn và ghi địa chỉ ô nào cũng được

---------------
Biết đến đâu nói đến đó. thiếu chỗ nào thì các bác bổ sung thêm giúp nha
 
Upvote 0
Xin Chào cả nhà Tôi là Tuanlichviet Thanh Viên mới Code lọc của Các bạn rất tuyệt cho tôi hỏi nếu chia sẻ sổ làm việc nó không còn tác dụng vậy phải làm thêm đoạn code nào Tôi rất cảm ơn bài viêt của các bạn. Đoạn code nay tôi copy ở trên
Private Sub Worksheet_Change(ByVal Target As Range)
Application.DisplayAlerts = False
If Target.Address = "$B$2" Then
Set DS = [A4].CurrentRegion
If Target = "" Then ActiveSheet.ShowAllData: Exit Sub
DS.AdvancedFilter Action:=1, CriteriaRange:=Range("B1:B2")
End If
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Web KT

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

Back
Top Bottom