Sửa giúp code để lọc dữ liệu (1 người xem)

  • Thread starter Thread starter ditimdl
  • Ngày gửi Ngày gửi
Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
ditimdl

ditimdl

Thành viên thường trực
Tham gia
11/10/06
Bài viết
378
Được thích
107
Giới tính
Nam
Nghề nghiệp
Pharmacist
PHP: 
Sub AutoFilterAndCopy()
Sheets("Data").[A1:A50].AutoFilter Field:=1, Criteria1:="A"
Sheets("Data").[A1].Select
Range(Selection, Selection.End(xlDown)).Select
''//Kiểm tra xem dữ liệu filter có rỗng hay không:
''//Nếu rỗng thì thoát khỏi thủ tục:
If Selection.Rows.Count >= 65536 Then
Exit Sub
Else
''//Nếu không rỗng mới copy:
Selection.Copy 
Sheets("Report").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End If
''//Phần này không hoạt động được
Sheets("Data").[A1:A50].AutoFilter Field:=1, Criteria1:="D"
Sheets("Data").[A1].Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy 
Sheets("Report2).select
range("A2").select
....
End Sub
</SPAN></SPAN>
Đoạn code trên mình dùng để lọc dữ liệu, anh ca_dafi thêm phần kiểm tra dữ liệu sau khi filter, nếu kết quả filter rỗng thì thoát khỏi thủ tục lọc và copy, ngược lại thì copy sang 1 sheet khác. Code hoạt động tốt nhưng nó lại làm cho các sub lọc tiếp theo không thể chạy được. Nhờ các bác giúp em sửa giúp code để sau khi lọc phần tử A xong thì đoạn code trên ko tiến hành lọc tiếp phần tử D.
(Phần này em post bên phần xử lý dữ liệu nhưng không đúng chủ đề nên ít nhận được sự hổ trợ nên em cắt qua bên này. Mong các bác giúp.)
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
ditimdl đã viết:
PHP: 
Sub AutoFilterAndCopy()
Sheets("Data").[A1:A50].AutoFilter Field:=1, Criteria1:="A"
Sheets("Data").[A1].Select
Range(Selection, Selection.End(xlDown)).Select
''//Kiểm tra xem dữ liệu filter có rỗng hay không:
''//Nếu rỗng thì thoát khỏi thủ tục:
If Selection.Rows.Count >= 65536 Then
Exit Sub
Else
''//Nếu không rỗng mới copy:
Selection.Copy 
Sheets("Report").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End If
''//Phần này không hoạt động được
Sheets("Data").[A1:A50].AutoFilter Field:=1, Criteria1:="D"
Sheets("Data").[A1].Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy 
Sheets("Report2).select
range("A2").select
....
End Sub
</SPAN></SPAN>
Đoạn code trên mình dùng để lọc dữ liệu, anh ca_dafi thêm phần kiểm tra dữ liệu sau khi filter, nếu kết quả filter rỗng thì thoát khỏi thủ tục lọc và copy, ngược lại thì copy sang 1 sheet khác. Code hoạt động tốt nhưng nó lại làm cho các sub lọc tiếp theo không thể chạy được. Nhờ các bác giúp em sửa giúp code để sau khi lọc phần tử A xong thì đoạn code trên ko tiến hành lọc tiếp phần tử D.
(Phần này em post bên phần xử lý dữ liệu nhưng không đúng chủ đề nên ít nhận được sự hổ trợ nên em cắt qua bên này. Mong các bác giúp.)
Nhấp chuột vào đây để mở rộng...

Có hai cách:
1. Đối với dòng lệnh Exit Sub bạn có thể gán đại một công thức "rác" như sau: a=1
2. Bạn có thể chia các thao tác lọc ra làm nhiều sub nhỏ, sau đó tạo một thủ tục gọi các sub nhỏ đó chạy, ví dụ:
PHP: 
Sub ChayHet()
Call AutoFilterAndCopyA
Call AutoFilterAndCopyB
Call AutoFilterAndCopyC
Call AutoFilterAndCopyD
End sub
 
Upvote 0
Thay chỗ If Selection.Rows.Count >= 65536 Then Exit Sub bằng

Mã: 
If Selection.Rows.Count >= 65536 Then
Mã: 
GoTo SecondF
[COLOR=#dd0000][COLOR=black]Else[/COLOR]
 
[COLOR=black]Selection.Copy Sheets("Report").Cells(1, 1)[/COLOR]
[COLOR=black]End If[/COLOR]
[B][COLOR=black]GoTo SecondF[/COLOR][/B]
 
[B][COLOR=black]SecondF:[/COLOR][/B]
[COLOR=black]Sheets("Data").[A1:a50].AutoFilter Field:=1, Criteria1:="D"[/COLOR][/COLOR]
[COLOR=#dd0000][COLOR=#000000].....[/COLOR][/COLOR]

Cách này để tham khảo thôi, cách của Cadafi hay hơn.
 
Upvote 0
Các anh xem dùm:
PHP: 
Sheets("TOTAL").Select
    ActiveSheet.Range("$A$4:$O$14004").AutoFilter Field:=5, Criteria1:="=T3*", _
        Operator:=xlAnd
    Range("A5").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    If Selection.Rows.Count >= 14 Then
    Sheets("TOTAL").Select
    ActiveSheet.Range("$A$4:$O$1004").AutoFilter Field:=5
    Else
    Selection.Copy
    Sheets("T3").Select
    Range("A5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
      
    End If
    ActiveSheet.Range("$A$4:$O$14").AutoFilter Field:=2, Criteria1:="<>"
   
    
'Lay loai the BV, B1, B2
    Sheets("TOTAL").Select
    ActiveSheet.Range("$A$4:$O$14004").AutoFilter Field:=5, Criteria1:="=B*", _
        Operator:=xlAnd
    Range("A5").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    'Bay loi khi du lieu khong ton tai
    If Selection.Rows.Count >= 1004 Then
    Sheets("TOTAL").Select
    ActiveSheet.Range("$A$4:$O$1004").AutoFilter Field:=5
    Else
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("BV").Select
    Range("A5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
     
    End If
    ActiveSheet.Range("$A$4:$O$1004").AutoFilter Field:=2, Criteria1:="<>"
End sub
Dòng Exit sub em thay bằng:
Sheets("TOTAL").Select
ActiveSheet.Range("$A$4:$O$1004").AutoFilter Field:=5
(Trở về sheet dữ liệu gốc chọn show all)
Nhưng khi loại thẻ T3 không tồn tại thì việc lọc loại thẻ B lại không tiếp tục diễn ra như mong muốn?
 
Upvote 0
Bạn có thể gửi file của bạn lên không? Như trong đoạn code của bạn, có mấy vấn đề như sau: Bạn xem ghi chú trong code của bạn!
PHP: 
Sheets("TOTAL").Select
    ActiveSheet.Range("$A$4:$O$14004").AutoFilter Field:=5, Criteria1:="=T3*", _
        Operator:=xlAnd
    Range("A5").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    If Selection.Rows.Count >= 14 Then    ''//Tại sao đoạn trên filter tới ô O14004 mà chỉ giới hạn count có 14 thôi??
    Sheets("TOTAL").Select   ''//Thử thay bằng a=1
    ActiveSheet.Range("$A$4:$O$1004").AutoFilter Field:=5    ''<=== Tại sao phải có dòng này
    Else
    Selection.Copy
    Sheets("T3").Select
    Range("A5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
      
    End If
    ActiveSheet.Range("$A$4:$O$14").AutoFilter Field:=2, Criteria1:="<>"
   
    
'Lay loai the BV, B1, B2
    Sheets("TOTAL").Select
    ActiveSheet.Range("$A$4:$O$14004").AutoFilter Field:=5, Criteria1:="=B*", _
        Operator:=xlAnd
    Range("A5").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    'Bay loi khi du lieu khong ton tai
    If Selection.Rows.Count >= 1004 Then
    Sheets("TOTAL").Select
    ActiveSheet.Range("$A$4:$O$1004").AutoFilter Field:=5  ''//Tại sao phải có dòng này!
    Else
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("BV").Select
    Range("A5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
     
    End If
    ActiveSheet.Range("$A$4:$O$1004").AutoFilter Field:=2, Criteria1:="<>"
End sub
Dòng Exit sub em thay bằng:
Sheets("TOTAL").Select
ActiveSheet.Range("$A$4:$O$1004").AutoFilter Field:=5
(Trở về sheet dữ liệu gốc chọn show all)
Nhưng khi loại thẻ T3 không tồn tại thì việc lọc loại thẻ B lại không tiếp tục diễn ra như mong muốn?[/QUOTE]
 
Upvote 0
1. If Selection.Rows.Count >= 14 Then: Thường thì có những loại thẻ ít khi xuất hiện nên trên sheet loại này em chỉ chừa 14dòng để gán dữ liệu. Khi filter rỗng thì dòng lệnh End(xlDown) nó chọn đến dòng 1048576 nên em dùng nó để so sánh nếu vượt quá 14 thì bỏ qua thao tác copy/paste.
2. Sheets("TOTAL").Select
ActiveSheet.Range("$A$4:$O$1004").AutoFilter Field:=5
(Trở về sheet dữ liệu gốc chọn show all) thay cho dòng lệnh Exit sub
File em đang test nên nhìn lung tung lắm anh à. (Trước giờ công việc này em vẫn làm bằng tay. Bây giờ em tập ghi lại macro và học hỏi thêm từ các anh chị.)
 
Upvote 0
Bạn thử thay đoạn code của bạn bằng đoạn này xem (nhớ backup lại nha):
PHP: 
Sheets("TOTAL").Select
    ActiveSheet.[A4:O14004].AutoFilter Field:=5, Criteria1:="=T3*"
    Range("A5").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    If Selection.Rows.Count >= 14 Then
    ZA = 1
    Else
    Selection.Copy
    Sheets("T3").[A5].PasteSpecial Paste:=xlPasteValues, _
    Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    End If
''//================================================================================
'Lay loai the BV, B1, B2:
    ActiveSheet.[A4:O14004].AutoFilter Field:=5, Criteria1:="=B*"
    Range("A5").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    'Bay loi khi du lieu khong ton tai:
    If Selection.Rows.Count >= 1004 Then
    ZA = 1
    Else
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("BV").[A5].PasteSpecial Paste:=xlPasteValues, _
    Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    End If
 
Upvote 0
Vẫn không có gì thay đổi anh à. Loại thẻ B* nó vẫn lọc ra nhưng ko copy/paste sang sheet BV được.
 
Upvote 0
Upvote 0
ditimdl đã viết:
PHP: 
Sub AutoFilterAndCopy()
Sheets("Data").[A1:A50].AutoFilter Field:=1, Criteria1:="A"
Sheets("Data").[A1].Select
Range(Selection, Selection.End(xlDown)).Select
''//Kiểm tra xem dữ liệu filter có rỗng hay không:
''//Nếu rỗng thì thoát khỏi thủ tục:
If Selection.Rows.Count >= 65536 Then
Exit Sub
Else
''//Nếu không rỗng mới copy:
Selection.Copy 
Sheets("Report").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End If
''//Phần này không hoạt động được
Sheets("Data").[A1:A50].AutoFilter Field:=1, Criteria1:="D"
Sheets("Data").[A1].Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy 
Sheets("Report2).select
range("A2").select
....
End Sub
</SPAN></SPAN>
Đoạn code trên mình dùng để lọc dữ liệu, anh ca_dafi thêm phần kiểm tra dữ liệu sau khi filter, nếu kết quả filter rỗng thì thoát khỏi thủ tục lọc và copy, ngược lại thì copy sang 1 sheet khác. Code hoạt động tốt nhưng nó lại làm cho các sub lọc tiếp theo không thể chạy được. Nhờ các bác giúp em sửa giúp code để sau khi lọc phần tử A xong thì đoạn code trên ko tiến hành lọc tiếp phần tử D.
(Phần này em post bên phần xử lý dữ liệu nhưng không đúng chủ đề nên ít nhận được sự hổ trợ nên em cắt qua bên này. Mong các bác giúp.)
Nhấp chuột vào đây để mở rộng...


Bạn phải xử lý thêm các lỗi :

- Kiểm tra xem sheet đó đã được đặt ở chế độ Autofilter chưa ?? Nếu chưa có thì phải set lại
- Autofilter có được đặt chính xác trong vùng dữ liệu hay không ?? Nếu không thì phải Set lại


Còn việc kiểm tra xem filter có dữ liệu không : Bạn nên dùng hàm match để kiểm tra vùng đó có dữ liệu đó không ?? Nếu không có thì bỏ qua, không dùng Filter nữa. Chứ không phải lúc nào cũng vào Sub là Filter bạn ạ.

Khi có nhiều dữ liệu thì mới thấy rằng làm như thế rất chậm (vì nó phải dò tất cả các hàng, và lại phải thực hiện việc ẩn hàng nữa)

Dim Vung as Range

Tìm chính xác ký tự A: Match("A",Vung,0)

Tìm bắt đầu có ký tự A : Match("A*",Vung,0)

Thân!
 
Upvote 0
To Mr Okebab: Thật sự nhìn vào code em chẳng hiểu gì cho lắm, em tập ghi lại macro để học hỏi thêm nên những điều anh nói em khó mà tưởng tượng ra như thế nào.
To Ca_dafi: Em đính kèm file theo bài viết có gì anh và các anh chị khác giúp em nha.
Yêu cầu:
- Lọc những loại phiếu bên sheet total và copy/paste vào sheet tương ứng, sau khi paste vào sheet tương ứng thì autofilter để loại ra những dòng rỗng luôn?
- Những mã nằm chung 1 nhóm:
+ A1, AV, AL: nằm chung một nhóm thẻ, lọc 3 loại thẻ này và copy vào sheet AV
+ T1, TC: lọc 2 loại này và copy vào sheet T1TC
+ T2, UC: tương tự copy qua sheet T2UC
+ IA, IB, HL: tương tự copy qua sheet HL
+ Các loại thẻ khác lọc và copy qua sheet có tên tương ứng luôn.
- Trong này những loại thẻ: FL, T3, GL, CV, trong dữ liệu đã xóa đi nên không có nhưng vẫn phải làm đầy đủ các thủ tục như các loại thẻ khác để khi dữ liệu thay đổi và những loại thẻ FL, T3, GL, CV... có trong vùng dữ liệu gốc thì code vẫn làm việc được.
Nếu có thể các anh chị làm bằng macro(Để em tham khảo học hỏi) và VBA luôn để em so sánh tốc độ xử lý của macro với VBA như thế nào?
(Dữ liệu thật có thể lên tới 30.000 dòng)
 

File đính kèm

Upvote 0
Tôi nhận xét rằng cái khó khăn ở đây chính là cách đặt tên sheet! (điều kiện lọc sẽ phụ thuộc vào tên sheet)
Nếu bạn biết cách khéo léo đặt tên sheet cho phù hợp thì chỉ cần 1 code duy nhất gán vào sự kiện Workbook_SheetActivate là xong chuyện! Mổi khi bạn chọn vào sheet nào thì tự động dử liệu của sheet ấy sẽ được lọc và cập nhật!
Thử suy nghĩ xem!
 
Upvote 0
To anh NDU: cảm ơn gợi ý của anh. Anh có thể biến gợi ý của anh vào file đính kèm phía trên dùm em được ko?
 
Upvote 0
ditimdl đã viết:
To anh NDU: cảm ơn gợi ý của anh. Anh có thể biến gợi ý của anh vào file đính kèm phía trên dùm em được ko?
Nhấp chuột vào đây để mở rộng...
Thật sự tôi cũng mới nghĩ ra thôi... và cũng đang phân vân không biết nên đặt tên sheet như thế nào là hợp lý... vượt qua được chổ này, mọi thứ khác sẽ trở nên rất đơn giãn...
Vậy mới thấy việc bố trí dử liệu hợp lý nó quan trọng đến chừng nào (ngay cả đến việc nhỏ nhất là đặt tên sheet)
Để tôi cố gắng nghĩ xem... Mong các cao thủ khác phụ giúp thêm 1 tay!
 
Upvote 0
Ah... đây! Bạn thử code này xem nha!
Cái này còn phải cải tiến thêm nhiều:
1> Bạn tự xử lý lấy dòng cuối cùng của các sheet (vì rất có thể dử liệu copy sang sẽ đè mất)... Theo tôi thì sau khi lọc sẽ thêm mấy chử này vào
2> Tôi sửa dử liệu của bạn 1 chút: Chèn thêm 1 dòng trống trên danh sách! Cái này quan trọng lắm đây, vì nhờ nó mà ta phân biệt đâu là dử liệu (tôi dùng CurrentRegion)
3> Tôi vẩn thấy Advanced Filter làm việc lọc này dể hơn nhiều so với AutoFiler và tôi đang làm theo hướng này
vân vân và vân vân...
Các cao thủ khác cải tiến thêm nha
Code:
PHP: 
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
  Dim Rng As Range
  Application.ScreenUpdating = False
  ShName = ActiveSheet.Name
  If ShName <> "TOTAL" And ShName <> "TONGHOP" Then
  [A5].CurrentRegion.ClearContents
    With Sheets("TOTAL")
      Set Rng = .[A5].CurrentRegion
      .[Q6] = Right(ShName, 2)
      .[Q7] = Left(ShName, 2)
      Rng.AdvancedFilter Action:=1, CriteriaRange:=.[Q5:Q7]
      Rng.SpecialCells(xlCellTypeVisible).Copy
      
    End With
    [A5].PasteSpecial xlPasteValues
    [A5].Select
    Application.CutCopyMode = False
    Sheets("TOTAL").ShowAllData
  End If
  Application.ScreenUpdating = True
End Sub
 

File đính kèm

Upvote 0
Code hoạt động tốt nhưng anh có thể sửa code trên để gán vào 1 command khi cần lọc thì sẽ click vào command đó. Để như thế này nhìn nó giật giật khó chịu lắm.
Làm sao để sửa điều kiện trong code đó: Ví dụ khi lọc loại AV để chép vào sheet AV mà sheet AV thì bao gồm những loại thẻ sau: AV, A1, AL cả 3 là 1 loại, HL: IA, IB, HL cả 3 là 1 loại...
PHP: 
ShName = ActiveSheet.Name
Điều kiện lọc thông qua tên sheet đúng ko anh? Nếu vậy thì làm sao đặt tên cho nó hiểu cả 3loại thẻ trên là 1họ với nhau?
Trước giờ em chưa dùng thử macro lần nào chứ nói gì đến code VBA nên giờ em muốn tìm hiểu để áp dụng vào công việc thông qua việc ghi lại các macro để xem. Mong các anh dành ít thời gian giúp em.
 
Lần chỉnh sửa cuối:
Upvote 0
ditimdl đã viết:
Code hoạt động tốt nhưng anh có thể sửa code trên để gán vào 1 command khi cần lọc thì sẽ click vào command đó. Để như thế này nhìn nó giật giật khó chịu lắm.
Làm sao để sửa điều kiện trong code đó: Ví dụ khi lọc loại AV để chép vào sheet AV mà sheet AV thì bao gồm những loại thẻ sau: AV, A1, AL cả 3 là 1 loại, HL: IA, IB, HL cả 3 là 1 loại...
.
Nhấp chuột vào đây để mở rộng...
Như tôi đã nói: Code này chỉ là thử... Còn nhiều vấn đề liên quan khác mà tập trung lại vấn dính đến tên sheet...
Để xem cái... Từ từ thôi....
ditimdl đã viết:
Trước giờ em chưa dùng thử macro lần nào chứ nói gì đến code VBA nên giờ em muốn tìm hiểu để áp dụng vào công việc thông qua việc ghi lại các macro để xem. Mong các anh dành ít thời gian giúp em
Nhấp chuột vào đây để mở rộng...
Code tôi làm ở trên thật ra cũng record macro rồi sửa lại thôi (trời nào nhớ nổi cú pháp)...
Trình tự tôi làm như sau:
1> Khi chọn vào 1 sheet bất kỳ không phải là TOTAL và TONGHOP thì nó sẽ lấy tên sheet, tách ra và gán vào cell Q6 và Q7 của Sheet TOTAL (chủ yếu để làm điều kiện lọc)
2> Advanced Filter theo điều kiện tại Q6, Q7 rồi copy toàn bộ Visible cell, paste vào sheet hiện hành (Visible cell được chọn bằng cách Ctrl + G\Special\Visible Cell only)
3> Show All Data cho Sheet TOTAL
Chỉ vậy thôi... Khá đơn giãn mà
Mấy cái rắc rối còn lại vẩn là nằm ở chổ làm sao biết được AV chính là AV, A1 và AL
Ai chà....
-----------------------
Tôi đang nghĩ đến 1 hướng rất khả thi.... Bạn tạo 1 danh mục trước, sau đó dùng các hàm tìm kiếm (như VLOOKUP chẳng hạn) rồi gán vào Q6, Q7, Q8... vân vân...
Danh mục này chủ yếu để biết tên sheet nào sẽ ăn với tên nào!
Bạn thử xem... Có gì ngày mai... tiếp nhé
Chúc thành công!
 
Lần chỉnh sửa cuối:
Upvote 0
Hướng của anh đang nghĩ đến em sẽ thử sau, em thấy anh dùng 2 hàm left right để lấy tên sheet làm điều kiện nên em thêm vào như sau:
.[Q8] = Mid(ShName, 4, 2) và sửa tên sheet AV thành AV-A1-AL thì ok.
PHP: 
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
  Dim Rng As Range
  Application.ScreenUpdating = False
  ShName = ActiveSheet.Name
  If ShName <> "TOTAL" And ShName <> "TONGHOP" Then
  [A5].CurrentRegion.ClearContents
    With Sheets("TOTAL")
      Set Rng = .[A5].CurrentRegion
      .[Q6] = Right(ShName, 2)
      .[Q7] = Left(ShName, 2)
      .[Q8] = Mid(ShName, 4, 2)
      Rng.AdvancedFilter Action:=1, CriteriaRange:=.[Q5:Q8]
      Rng.SpecialCells(xlCellTypeVisible).Copy
      
    End With
    [A5].PasteSpecial xlPasteValues
    [A5].Select
    Application.CutCopyMode = False
    Sheets("TOTAL").ShowAllData
  End If
  Application.ScreenUpdating = True
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Giờ làm tạm bằng Select Case để phân ra các trường hợp:
PHP: 
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
  Dim Rng As Range
  Application.ScreenUpdating = False
  ShName = ActiveSheet.Name
  If ShName = "TOTAL" Or ShName = "TONGHOP" Then
     Exit Sub
  Else:
    [A5].CurrentRegion.ClearContents
    With Sheets("TOTAL")
      Set Rng = .[A5].CurrentRegion
      .[Q6:Q20].ClearContents
      Select Case ShName
         Case Is = "JL", "T3", "GL", "IS", "FL", "VC"
            .[Q6] = ShName
         Case Is = "T1TC"
            .[Q6] = "T1": .[Q7] = "TC"
         Case Is = "T2UC"
            .[Q6] = "T2": .[Q7] = "UC"
         Case Is = "HL"
            .[Q6] = "HL": .[Q7] = "IA": .[Q8] = "IB"
         Case Is = "AV"
            .[Q6] = "AV": .[Q7] = "A1": .[Q8] = "AL"
         Case Is = "BV"
            .[Q6] = "BV": .[Q7] = "B1": .[Q8] = "B2"
         Case Is = "EL"
            .[Q6] = "EL": .[Q7] = "ES"
         Case Is = "CV"
            .[Q6] = "CV": .[Q7] = "H3"
         Case Is = "DV"
            .[Q6] = "DV": .[Q7] = "H1"
      End Select
      Rng.AdvancedFilter Action:=1, CriteriaRange:=.[Q5].CurrentRegion
    End With
    Rng.SpecialCells(xlCellTypeVisible).Copy
    [A5].PasteSpecial xlPasteValues
    [A5].Select
    Application.CutCopyMode = False
    Sheets("TOTAL").ShowAllData
  End If
End Sub
Không hay lắm nhưng tôi nghĩ là đã đủ các trường hợp bạn cần rồi đấy
 

File đính kèm

Upvote 0
Làm thế nào để gắn nó vào 1 command và khi cần lọc ta mới click command để lọc vậy anh NDU?
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

MrAnt
Dùng excel add-in lấy báo cáo từ SQL
Trả lời
4
Đọc
205
ptm0412
ptm0412
H
  • Question Question
userform nhập liệu và tìm kiếm bị báo lỗi
    • Cười
Trả lời
7
Đọc
216
SA_DQ
SA_DQ
chothadiem
Xuất hiện "ký tự lạ trong word" (1 người xem)
Trả lời
3
Đọc
119
chothadiem
chothadiem
V
Xin file Excel Báo cáo tài chính hợp nhất mẫu kiểm toán
Trả lời
4
Đọc
145
Hoale85
H
Nguyễn Duy Tuân
  • Dán lên cao
Sử dụng AI trong Excel với Add-in A-Tools AI v10
    • Thích
    • Cảm ơn
Trả lời
3
Đọc
393
Nguyễn Duy Tuân
Nguyễn Duy Tuân
OverAC
Thân mời tham dự sự kiện sinh nhật GPE 2025 (1 người xem)
    • Thích
    • Yêu thích
Trả lời
0
Đọc
632
OverAC
OverAC
N
  • Question Question
Xin giúp đỡ về tìm kiếm dữ liệu trên Form
Trả lời
8
Đọc
284
ptm0412
ptm0412
Tiger Nau
Xóa màu nền trong file word (1 người xem)
Trả lời
8
Đọc
182
VetMini
V
T
Tổng hợp số lượng xuất ở nhiều sheet về 1 sheet
    • Cười
2
Trả lời
31
Đọc
936
DeTong
D
Emyeuexcel
Cộng 4 tuần theo 1 qui luật qui định
2
Trả lời
29
Đọc
1K
HieuCD
H
Cao Mạnh Sơn
Thắc mắc về file excel 2007 không chạy Macro khi đặt Pass
Trả lời
16
Đọc
8K
anhvan1972
A
chothadiem
Lỗi font chữ khi sử dụng VBA trong word
Trả lời
3
Đọc
193
chothadiem
chothadiem
Linhlicer
Khắc phục file Excel bị lưu đè lên file cũ.
    • Buồn
Trả lời
3
Đọc
350
vietduc147258
V
HeSanbi
  • Question Question
Hàm SpellNumVN - Đọc số thành chữ, chuyển chữ thành số, kể cả số thập phân
    • Thích
    • Yêu thích
Trả lời
18
Đọc
4K
HeSanbi
HeSanbi
chothadiem
Gán phím tắt Alt+1 bằng Quick Access Toolbar nhưng không có tác dụng
Trả lời
8
Đọc
342
chothadiem
chothadiem
PhanTuHuong
Sách Lập trình VBA trong AutoCAD và Civil 3D đọc online miễn phí!
    • Thích
    • Yêu thích
2
Trả lời
26
Đọc
3K
PhanTuHuong
PhanTuHuong
hoamattroicoi
Trích xuất file *.xml sang Excel cho hóa đơn điện tử áp dụng nghị định 123/2020 (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
5 6 7
Trả lời
124
Đọc
36K
thaontlthao
T
M
  • Question Question
Tự động quét lấy hyperlink trong 1 forder (1 người xem)
Trả lời
6
Đọc
990
zigzagarc2
Z
Nguyễn Duy Tuân
  • Dán lên cao
Phiên bản mới Add-in A-Tools v10 (2024)
    • Thích
2 3
Trả lời
53
Đọc
6K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
TRA KHUC RIVER
Công thức không chạy theo khi sort
    • Thích
Trả lời
13
Đọc
14K
HuyenTrang4848
H
Xem thêm…

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

Sinh nhật lần 19 GPE

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom