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

[ditimdl]

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.)

 

[cadafi]

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.)

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ụ:

Sub ChayHet()
Call AutoFilterAndCopyA
Call AutoFilterAndCopyB
Call AutoFilterAndCopyC
Call AutoFilterAndCopyD
End sub

 

[ptm0412]

Thay chỗ If Selection.Rows.Count >= 65536 Then Exit Sub bằng

If Selection.Rows.Count >= 65536 Then

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.

 

[ditimdl]

Các anh xem dùm:

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?

 

[cadafi]

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!

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]

 

[ditimdl]

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ị.)

 

[cadafi]

Bạn thử thay đoạn code của bạn bằng đoạn này xem (nhớ backup lại nha):

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

 

[ditimdl]

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.

 

[cadafi]

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.

Bạn lọc bằng tay xem có bao nhiêu dòng thỏa mãn loại thẻ B.

Ps: không có file khó làm quá đi!

 

[Mr Okebab]

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.)

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!

 

[ditimdl]

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)

 

[ndu96081631]

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!

 

[ditimdl]

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?

 

[ndu96081631]

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?

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!

 

[ndu96081631]

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:

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

 

[ditimdl]

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...

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.

 

[ndu96081631]

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ư 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....

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

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!

 

[ditimdl]

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.

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

 

[ndu96081631]

Giờ làm tạm bằng Select Case để phân ra các trường hợp:

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

 

[ditimdl]

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?

 

[ndu96081631]

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?

Chưa hiểu ý bạn về cái ComboBox này!
Tôi vẩn còn 1 thắc mắc: File của bạn có quá trời sheet luôn, vậy tại sao bạn không làm 3 sheet thôi: 1 sheet nhập, 1 sheet TRÍCH (trong này có ComboBox cho bạn chọn LOẠI) và sheet TỔNG HỢP
Tôi nghĩ chỉ có trường hợp bạn làm 3 sheet thì mới cần đến ComboBox để chọn chứ nhỉ...

 

[ditimdl]

Dữ liệu ở sh total được trích ra từ 1file khác dùng để báo cáo, nhưng bên Bảo hiểm y tế họ bắt phải lọc ra từng loại để họ theo dõi từng nguồn quỹ cho họ thì phải.
Công việc này 1 quý mới làm 1 lần. Em muốn file này gắn 2 command: 1 cái dùng để copy dữ liệu từ file khác qua file lọc ở sh total(em đã làm được) Phần còn lại là lọc chia ra từng loại thẻ vào những sh cụ thể em đã tạo sẵn trong file lọc.
Em cần tạo ra 1command lọc, khi em cần lọc thì chọn command đó thì nó lọc còn ko thì ko được lọc.

 

[ndu96081631]

Dữ liệu ở sh total được trích ra từ 1file khác dùng để báo cáo, nhưng bên Bảo hiểm y tế họ bắt phải lọc ra từng loại để họ theo dõi từng nguồn quỹ cho họ thì phải.
Công việc này 1 quý mới làm 1 lần. Em muốn file này gắn 2 command: 1 cái dùng để copy dữ liệu từ file khác qua file lọc ở sh total(em đã làm được) Phần còn lại là lọc chia ra từng loại thẻ vào những sh cụ thể em đã tạo sẵn trong file lọc.
Em cần tạo ra 1command lọc, khi em cần lọc thì chọn command đó thì nó lọc còn ko thì ko được lọc.

Ah... xin lổi! Tôi đọc nhầm tưởng bạn nói ComboBox!
Nếu muốn thế cũng dể mà! Nhanh nhất là sửa lại code trên 1 tí (cho nó vào Sub và thêm 1 vòng lập For quét qua các sheet ---> Thay vì lúc trước ta chọn sheet thì code chạy)
Như thế này đây:

Sub Locdulieu()
  Dim Rng As Range, Sh As Worksheet
  Application.ScreenUpdating = False
  For Each Sh In ThisWorkbook.Worksheets
    If Sh.Name <> "TOTAL" And Sh.Name <> "TONGHOP" Then
       Sh.[A5].CurrentRegion.ClearContents
       With Sheets("TOTAL")
         Set Rng = .[A5].CurrentRegion
         .[Q6:Q20].ClearContents
         Select Case Sh.Name
            Case Is = "JL", "T3", "GL", "IS", "FL", "VC"
               .[Q6] = Sh.Name
            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
       Sh.[A5].PasteSpecial xlPasteValues
       Sheets("TOTAL").ShowAllData
     End If
  Next Sh
  Application.CutCopyMode = False
  Application.ScreenUpdating = True
End Sub

Bạn hãy so sánh code này và code của bài trên để xem chúng khác nhau chổ nào nhé (gần như giống đến 99%)

 

[ditimdl]

Cảm ơn anh NDU nhiều nha. Code chạy nhanh ghê, 20.000dòng mà mất chưa tới 10s.
1. Với code trên nếu ta insert thêm 1 số sh vào (những sh này không liên quan gì đến quá trình lọc và copy/paste) thì chạy đoạn code trên nó báo lỗi ở dòng:

Sheets("TOTAL").ShowAllData

(Nó tô màu vàng ở dòng này) và nó copy nguyên sh TOTAL qua những sh mới insert đó. Làm sao để nó không đụng chạm gì đến những sh đó?
2. Sau khi lọc copy qua những sh dựa theo điều kiện lọc thì phải làm sao để nó autofil loại bỏ những dòng rỗng để khi in em khỏi phải autofil từng sh. (Cái này em ghi macro lại cũng được nhưng như vậy thì tệ quá nên đành nhờ anh tiếp vậy).
Các sh về cấu trúc thì giống nhau nhưng số dòng thì khác nhau chắc khó cho anh rồi.

Vậy anh NDU viết code dùm em để bỏ qua những sh khác ngoài những sh đã có trong file lọc ở trên?
3. Trước khi chạy sub lọc phiếu nên xóa hết nhữg kết quả đã lọc lần trước để tránh sai sót. (Cái này em cũng ghi macro luôn rồi nhưng dài lê thê lắm, phải chỉ ra từng trường hợp để clearcontents nhìn oải luôn)

 

[ngoctrongdat]

Cảm ơn những bài viết bổ ích của bạn ndu!
Tôi đang tập với excel nên rất mong được chỉ giáo.
Tôi có một bảng lí lịch các giáo viên( STT, Họ tên, Ngày sinh, Chuyên môn đào tạo, năm vào ngành, bậc lương, ...) (Tạm gọi là sheet 1).
Bây giờ tôi muốn có một bảng tương tự nhưng chỉ có những giáo viên có chuyên môn đào tạo là Toán (gọi là sheet 2). Tôi phải làm như thế nào?

 

[ndu96081631]

Cảm ơn anh NDU nhiều nha. Code chạy nhanh ghê, 20.000dòng mà mất chưa tới 10s.
1. Với code trên nếu ta insert thêm 1 số sh vào (những sh này không liên quan gì đến quá trình lọc và copy/paste) thì chạy đoạn code trên nó báo lỗi ở dòng:

Sheets("TOTAL").ShowAllData

(Nó tô màu vàng ở dòng này) và nó copy nguyên sh TOTAL qua những sh mới insert đó. Làm sao để nó không đụng chạm gì đến những sh đó?
Vậy anh NDU viết code dùm em để bỏ qua những sh khác ngoài những sh đã có trong file lọc ở trên?

Trong code có đoạn

If Sh.Name <> "TOTAL" And Sh.Name <> "TONGHOP" Then

dùng để bỏ qua sheet TOTAL và TONGHOP... Vậy nếu bạn muốn không đụng đến sheet nào đó thì thêm vào điều kiện này! Ví dụ bỏ qua sheet có tên là DITIMDL thi

If Sh.Name <> "TOTAL" And Sh.Name <> "TONGHOP" And Sh.Name <> "DITIMDL" Then

2. Sau khi lọc copy qua những sh dựa theo điều kiện lọc thì phải làm sao để nó autofil loại bỏ những dòng rỗng để khi in em khỏi phải autofil từng sh. (Cái này em ghi macro lại cũng được nhưng như vậy thì tệ quá nên đành nhờ anh tiếp vậy).
Các sh về cấu trúc thì giống nhau nhưng số dòng thì khác nhau chắc khó cho anh rồi.

Đoạn code này:

Sh.[A5].PasteSpecial xlPasteValues

là vừa copy và paste sang các sheet... Vậy sau đoạn này ta sẽ AutoFilter, chẳng hạn:

Sh.[A5:O10000].AutoFilter Field:=1, Criteria1:="<>"

Với số 10000 là số dòng lớn nhất trong các sheet (bạn sửa lại cho phù hợp)

3. Trước khi chạy sub lọc phiếu nên xóa hết nhữg kết quả đã lọc lần trước để tránh sai sót. (Cái này em cũng ghi macro luôn rồi nhưng dài lê thê lắm, phải chỉ ra từng trường hợp để clearcontents nhìn oải luôn)

Cái này tôi đã có làm rồi mà, nằm ở code này:

Sh.[A5].CurrentRegion.ClearContents

Kết luận: Code gợi ý cho bạn có thể là:

Sub Locdulieu()
  Dim Rng As Range, Sh As Worksheet
  Application.ScreenUpdating = False
  For Each Sh In ThisWorkbook.Worksheets
    If Sh.Name <> "TOTAL" And Sh.Name <> "TONGHOP" Then 'chổ này thêm vào tên sheet nào đó bạn muốn bỏ qua nhé
       Sh.[A5].CurrentRegion.ClearContents
       With Sheets("TOTAL")
         Set Rng = .[A5].CurrentRegion
         .[Q6:Q20].ClearContents
         Select Case Sh.Name
            Case Is = "JL", "T3", "GL", "IS", "FL", "VC"
               .[Q6] = Sh.Name
            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
       Sh.[A5].PasteSpecial xlPasteValues
       Sh.[A5:O10000].AutoFilter Field:=1, Criteria1:="<>" 'Cái này để AutoFilter NonBlanks
       Sheets("TOTAL").ShowAllData
     End If
  Next Sh
  Application.CutCopyMode = False
  Application.ScreenUpdating = True
End Sub

 

[ndu96081631]

Cảm ơn những bài viết bổ ích của bạn ndu!
Tôi đang tập với excel nên rất mong được chỉ giáo.
Tôi có một bảng lí lịch các giáo viên( STT, Họ tên, Ngày sinh, Chuyên môn đào tạo, năm vào ngành, bậc lương, ...) (Tạm gọi là sheet 1).
Bây giờ tôi muốn có một bảng tương tự nhưng chỉ có những giáo viên có chuyên môn đào tạo là Toán (gọi là sheet 2). Tôi phải làm như thế nào?

Đơn giãn nhất là bạn AutoFiler theo cột "Chuyên môn đào tạo"... Lọc ra môn toán rồi copy sang sheet 2
Nếu khéo hơn thì có thể ghi lại macro quá trình này... Bấm nút 1 nhát nó làm luôn
Nếu có khó khăn thi đưa file lên, tôi mới làm cụ thể cho bạn được

 

[ndu96081631]

Chào bạn ditimdl
Tôi vẩn cãm thấy file trên cần phải cải tiến thêm:
1> Các sheet mà ta lọc ra bạn đang cho dòng TỔNG CỘNG nằm ở dòng thứ 4039... Như vậy nếu dử liệu chỉ có mấy dòng thì ta đang tốn gần 4000 dòng cho việc Format mà chẳng làm gì cả... Nó làm cho dung lượng file tăng đáng kể... (File bạn hiện có dung lượng trên 1M, tôi làm theo kiểu mới chỉ còn 150K)
2> Với cách bố trí dử liệu trên tuy rằng bạn gặp thuận lợi về công thức ở sheet TONGHOP nhưng lại mất công AutoFilter NonBlanks cho từng sheet... Tôi thấy không đẹp cho lắm
Vậy tôi có cách này, bạn sẽ không bạn tâm về vụ AutoFilter NonBlanks nữa... Mặc khác ở sheet TONGHOP cũng không cần công thức luôn (vì đã VBA rồi thì làm luôn 1 thể nhỉ)
Code đây:

Sub Locdulieu()
  Dim Rng As Range, Temp As Range, Sh As Worksheet, i As Long, ShName
  Application.ScreenUpdating = False
  i = 6
  ShName = Array("T1TC", "T2UC", "HL", "EL", "JL", "AV", "DV", "T3", "BV", "IS", "GL", "FL", "VC", "CV")
  For Each Sh In ThisWorkbook.Worksheets
    DK = Application.HLookup(Sh.Name, ShName, 1, 0)
    If Not IsError(DK) Then
       Sh.Range("A5").CurrentRegion.EntireRow.Delete
       With Sheets("TOTAL")
          Set Rng = .[A5].CurrentRegion
          .[Q6:Q20].ClearContents
          Select Case Sh.Name
            Case Is = "JL", "T3", "GL", "IS", "FL", "VC": .[Q6] = Sh.Name
            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
          Rng.SpecialCells(xlCellTypeVisible).Copy Destination:=.[A30000]
       End With
       With Sheets("TOTAL").[A30000].CurrentRegion
          .Copy: Sh.[A5].Insert Shift:=xlDown
          .ClearContents: .ClearFormats
       End With
       Set Temp = Sh.[A5].CurrentRegion
       Temp.Offset(Temp.Rows.Count + 1, 2).Resize(1, 13).SpecialCells(3, 23).Copy
       Sheets("TONGHOP").Cells(i, 3).PasteSpecial xlPasteValues
       If Temp.Rows.Count > 1 Then
          With Temp.Offset(1, 0).Resize(Temp.Rows.Count - 1, 1)
             .Formula = "=ROW() -5"
             .Value = .Value
          End With
       End If
       Sheets("TOTAL").ShowAllData
       i = i + 1
     End If
   Next Sh
   Application.CutCopyMode = False
   Application.ScreenUpdating = True
End Sub

Việc chèn 1 sheet có tên không nằm trong list cho trước sẽ không ảnh hưởng gì đến code cả
Xem file đính kèm và cho biết ý bạn thế nào nhé!

 

[ditimdl]

Cảm ơn về những góp ý và thời gian anh đã dành cho em. Những ý anh nói ở trên em cũng đã nghĩ đến nhưng không ngờ anh lại cải tiến trước khi em đặt câu hỏi. Mong anh dành thêm chút thời gian nói sơ về những đoạn code trên cho em học hỏi thêm được không? Nói đến công thức excel may ra em còn biết đôi chút chứ để liên kết các code lại cho nó logic thì chỉ có tưởng tượng ra mà thôi.
Sắp tới em có thể nhờ anh xem qua file làm việc chính thức để giúp em sửa lại và có thể dùng code VBA để trợ giúp chứ dữ liệu ngày càng lớn ~20000 gây nên tình trạng rất chậm . (File lọc này thực hiện thêm 1 công việc nữa là copy những dữ liệu ở file làm việc ra sau khi chốt quý)

 

[ndu96081631]

Cảm ơn về những góp ý và thời gian anh đã dành cho em. Những ý anh nói ở trên em cũng đã nghĩ đến nhưng không ngờ anh lại cải tiến trước khi em đặt câu hỏi. Mong anh dành thêm chút thời gian nói sơ về những đoạn code trên cho em học hỏi thêm được không? Nói đến công thức excel may ra em còn biết đôi chút chứ để liên kết các code lại cho nó logic thì chỉ có tưởng tượng ra mà thôi.
Sắp tới em có thể nhờ anh xem qua file làm việc chính thức để giúp em sửa lại và có thể dùng code VBA để trợ giúp chứ dữ liệu ngày càng lớn ~20000 gây nên tình trạng rất chậm . (File lọc này thực hiện thêm 1 công việc nữa là copy những dữ liệu ở file làm việc ra sau khi chốt quý)

Cái này cũng dể thôi mà ---> gần giống với code của các bài trước!
Chỉ làm thêm mấy món:
- Đầu tiên tôi đặt dòng tổng cộng và mấy thứ linh tinh vào dòng 7 của các sheet... Đặt sẳn công thức (để cho chắc ăn tôi dùng INDIRECT... bạn xem kỹ lại nhé)
- Sau đó thì cứ copy ở TOTAL thì dùng Insert Copy cells (chứ không paste bình thường)... Bạn có thể record macro vụ Insert Copy cells này để tham khảo
- Tiếp theo xác định dòng THÀNH TIỀN ở từng sheet, chỉ lấy phần có công thức (Ctrl + G\Special\Formula) rồi paste vào từng dòng trong sheet TONGHOP
Có thể bạn nhìn vào nguyên đoạn code và cãm thấy ngợp, thật ra bạn có thể phân tích từng đoạn nhỏ, mỗi đoạn làm 1 nhiệm vụ (gần giống như khi ta lồng các công thức Excel vào với nhau)... Bạn hiểu từng đoạn 1 thì ráp chúng lại sẽ trở thành 1 quá trình hoàn chỉnh!

 

[ditimdl]

Gửi anh NDU & các anh chị trên diễn đàn!

File em đính kèm theo dữ liệu khoảng 20.000 dòng (file này dùng để nhập dữ liệu) và khoảng 9column x2(Mặt hàng và số lượng).
Trước thì em dùng vlookup tính giá trong file luôn nên rất nặng, em nhờ anh viết code để tính giá:
- Tính giá luôn trong file đính kèm?
- Copy dữ liệu qua 1 file khác và áp giá vào>> copy/paste value lại?
Anh xem 2 phương án trên với dữ liệu em đưa ra ở trên cái nào hợp lý hơn?
Cảm ơn!

 

[ndu96081631]

Gửi anh NDU!
!

Ai dà... cái vụ này sư phụ Sa đã từng có ý kiến rằng: "Không nêu nêu đích danh 1 ai đó" ... như ở đây bạn gọi đích danh tôi... Lở như tôi làm không được thì người khác cũng ngại tham gia (có nhờ đâu mà giúp)
Tôi sẽ cố gắng xem yêu cầu của bạn, tuy nhiên bạn nên sửa lại nội dung bài viết 1 tí... Kẻo phiền (cho chính bạn)

 

[ditimdl]

Sub Locdulieu()
  Dim Rng As Range, Temp As Range, Sh As Worksheet, i As Long, ShName
  Application.ScreenUpdating = False
  i = 6
  ShName = Array("T1TC", "T2UC", "HL", "EL", "JL", "AV", "DV", "T3", "BV", "IS", "GL", "FL", "VC", "CV")
  For Each Sh In ThisWorkbook.Worksheets
    DK = Application.HLookup(Sh.Name, ShName, 1, 0)
    If Not IsError(DK) Then
       Sh.Range("A5").CurrentRegion.EntireRow.Delete
       With Sheets("TOTAL")
          Set Rng = .[A5].CurrentRegion
          .[Q6:Q20].ClearContents
          Select Case Sh.Name
            Case Is = "JL", "T3", "GL", "IS", "FL", "VC": .[Q6] = Sh.Name
            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
          Rng.SpecialCells(xlCellTypeVisible).Copy Destination:=.[A30000]
       End With
       With Sheets("TOTAL").[A30000].CurrentRegion
          .Copy: Sh.[A5].Insert Shift:=xlDown
          .ClearContents: .ClearFormats
       End With
       Set Temp = Sh.[A5].CurrentRegion
       Temp.Offset(Temp.Rows.Count + 1, 2).Resize(1, 13).SpecialCells(3, 23).Copy
       Sheets("TONGHOP").Cells(i, 3).PasteSpecial xlPasteValues
       If Temp.Rows.Count > 1 Then
          With Temp.Offset(1, 0).Resize(Temp.Rows.Count - 1, 1)
             .Formula = "=ROW() -5"
             .Value = .Value
          End With
       End If
       Sheets("TOTAL").ShowAllData
       i = i + 1
     End If
   Next Sh
   Application.CutCopyMode = False
   Application.ScreenUpdating = True
End Sub

</SPAN></SPAN>Trong sub lọc và tách dữ liệu ra các sheet thì số thứ tự được đánh lại từ 1...chứ không lấy theo số thứ tự đã đánh sẵn trước. Vậy cho em hỏi phải sửa lại code như thế nào để nó lấy theo số thứ tự ban đầu?

 

[ndu96081631]

Trong sub lọc và tách dữ liệu ra các sheet thì số thứ tự được đánh lại từ 1...chứ không lấy theo số thứ tự đã đánh sẵn trước. Vậy cho em hỏi phải sửa lại code như thế nào để nó lấy theo số thứ tự ban đầu?

Thì file tôi gữi bạn, khi lọc ra các sheet đã đánh số thứ tự lại rồi còn gì (đánh STT từ 1 đến hết)
Bạn xem lại thừ

 

[ditimdl]

Khi lọc ra các loại thẻ thì số thứ tự của các sheet phải khác nhau chứ anh?
Ví dụ số 1 em có loại thẻ AV, Số 2 em có loại thẻ TC
Vậy sau khi lọc ra và gán dữ liệu cho từng sheet tương ứng thì AV nằm ở sheet AV và nó là số 1, TC nằm qua sheet T1TC nhưng nó phải là số 2 như dữ liệu gốc? chứ ko phải đánh số bắt đầu từ 1.

 

[ndu96081631]

Khi lọc ra các loại thẻ thì số thứ tự của các sheet phải khác nhau chứ anh?
Ví dụ số 1 em có loại thẻ AV, Số 2 em có loại thẻ TC
Vậy sau khi lọc ra và gán dữ liệu cho từng sheet tương ứng thì AV nằm ở sheet AV và nó là số 1, TC nằm qua sheet T1TC nhưng nó phải là số 2 như dữ liệu gốc? chứ ko phải đánh số bắt đầu từ 1.

Có nghĩa là bạn muốn giữ nguyên STT theo bảng gốc? Vậy càng dể (làm tôi mất công viết thêm chổ này vì nghĩ phải đánh lại STT mới đẹp... Ẹc... Ẹc...)
Vậy thì xóa nguyên đoạn này nhé:

       If Temp.Rows.Count > 1 Then
          With Temp.Offset(1, 0).Resize(Temp.Rows.Count - 1, 1)
             .Formula = "=ROW() -5"
             .Value = .Value
          End With
       End If

 

[trungdpc]

Chào bạn, mình xem file nhưng có chổ cần hỏi bạn giúp vì mình cũng cần làm một file gần giống như vậy. Nếu có tên trùng trong một sheet nào đó thì số tiền khám chữa bệnh có cộng dồn vào sheet total không

 

[ditimdl]

Trong file mẫu mình có chèn thêm 3 cột trong sheet TOTAL (Tổng chi phí KCB, Máu, Chi phí VC bệnh nhân) lúc này vùng điều kiện để lọc chuyển sang cột T chứ không còn nằm ở cột Q như file đính kèm ở bài 28, mình có sửa vùng điều kiện để lọc từ Q6:Q20... kết quả lọc ra như ý muốn nhưng mình không biết làm sao đưa kết quả các cột mới thêm vào sheet Tổng hợp.
Mình nghĩ nó nằm ở đoạn code này nhưng không hiểu nó nên chẳng sửa được nên nhờ các bạn giúp mình.

Set Temp = Sh.[A5].CurrentRegion
       Temp.Offset(Temp.Rows.Count + 1, 2).Resize(1, 13).SpecialCells(3, 23).Copy
       Sheets("TONGHOP").Cells(i, 3).PasteSpecial xlPasteValues

 

[ndu96081631]

Trong file mẫu mình có chèn thêm 3 cột trong sheet TOTAL (Tổng chi phí KCB, Máu, Chi phí VC bệnh nhân) lúc này vùng điều kiện để lọc chuyển sang cột T chứ không còn nằm ở cột Q như file đính kèm ở bài 28, mình có sửa vùng điều kiện để lọc từ Q6:Q20... kết quả lọc ra như ý muốn nhưng mình không biết làm sao đưa kết quả các cột mới thêm vào sheet Tổng hợp.
Mình nghĩ nó nằm ở đoạn code này nhưng không hiểu nó nên chẳng sửa được nên nhờ các bạn giúp mình.

Set Temp = Sh.[A5].CurrentRegion
       Temp.Offset(Temp.Rows.Count + 1, 2).Resize(1, 13).SpecialCells(3, 23).Copy
       Sheets("TONGHOP").Cells(i, 3).PasteSpecial xlPasteValues

Trong sheet TOTAL, do bạn chèn 3 cột nên cột Q lúc trước bây giờ sẽ biến thành cột T, đúng không?
Vậy trong code, chô nào là [Q..] thì bạn sửa thành [T..] ---> Bấm Ctrl + H, thay [Q thành [T
Thử xem

 

[ditimdl]

Thay Q thành T thì em làm được rồi, lọc theo mã từng sheet thì ok nhưng không biết sửa code như thế nào để nó lấy thêm 3 cột mới thêm vào đưa qua sheet tổng hợp.
Các bạn giúp mình với.

 

[ndu96081631]

Thay Q thành T thì em làm được rồi, lọc theo mã từng sheet thì ok nhưng không biết sửa code như thế nào để nó lấy thêm 3 cột mới thêm vào đưa qua sheet tổng hợp.
Các bạn giúp mình với.

Giờ bạn thêm bên sheet TONGHOP như thế nào, bạn cứ cho vào file mới hình dung được bạn à (tôi không thấy bên sheet TONGHOP thêm cột nào nên không làm được)
-----------------
Ah... hình như tôi đoán ra được rồi... bạn làm như sau:
- Ở sheet TOTAL bạn thêm cột thế nào thì các sheet con và sheet TONGHOP bạn cũng thêm cột tương ứng như thế
- Các sheet con, cột nào cần thêm thì chú ý bên dưới nhớ điền công thức SUBTOTAL(...) vào
- Vào code, thay đoạn:
Temp.Offset(Temp.Rows.Count + 1, 2).Resize(1, 13).SpecialCells(3, 23).Copy
thành:
Temp.Offset(Temp.Rows.Count + 1, 2).Resize(1, 16).SpecialCells(3, 23).Copy
Thêm 3 cột, đương nhiên phải Resize 16 rồi (lúc trước là 13)
Bạn thử xem ---> Có gì trục trặc lại bàn tiếp

 

[ditimdl]

Ok được rồi, cái này nó dựa vào tên nhãn của cột để lấy dữ liệu sang sheet tổng hợp phải không anh?

(Temp.Rows.Count + 1, 2)[/B]
[B]SpecialCells(3, 23).Copy

Anh giải thích những con số trong đó cho em hiểu thêm tí được không?

 

[ndu96081631]

Ok được rồi, cái này nó dựa vào tên nhãn của cột để lấy dữ liệu sang sheet tổng hợp phải không anh?

(Temp.Rows.Count + 1, 2)

[B]SpecialCells(3, 23).Copy[/B]

Anh giải thích những con số trong đó cho em hiểu thêm tí được không?

1> (Temp.Rows.Count + 1, 2)
Viết đủ hơn phải là
Temp.Offset(Temp.Rows.Count + 1, 2)
Mà
Temp = Sh.[A5].CurrentRegion
Vậy có nghĩa là:
- Ta đặt con trỏ chuột tại A5 (ở từng sheet con) rồi bấm Ctrl + Shift + * ---> Nó sẽ chọn nguyên vùng có liên quan đến A5
- Tiếp theo Offset(Temp.Rows.Count + 1, 2) là dịch xuống với số dòng đúng = số dòng của Temp và thêm 1 đơn vị nữa (ví dụ: Temp có 5 dòng thì ta dịch xuống 6 dòng)... rồi dịch sang phải 2 cột ---> Đây chính là dòng tổng cuối trang của từng sheet con (bạn đếm thử xem có đúng như tôi tính toán không?)
2> SpecialCells(3, 23).Copy ---> Chỉ copy các cell có công thức
Quan trọng ở mục 2 này đây ---> Bạn muốn copy cột nào, chỉ cần đặt công thức phía dưới là nó copy tuốt ---> Đơn giản vậy thôi chứ không phải là "nó dựa vào tên nhãn của cột để lấy dữ liệu"

 

[truongthienbinh]

Đệ có cái EXcel tính lương tự động nhưng dữ liệu row trong excel không đủ (thực tế CN, mã hàng nhiều lắm), với lại Excel chạy chậm lắm. Các huynh có cách gì cải tiến nó 1 chút không. Nhờ các huynh bỏ chút thời gian nghiên cứu sửa cho đệ với.
Mình up ở đây nha: vì trong diễn đàn ko up đc
http://www.4shared.com/file/98223454...luong_may.html
Xin cảm ơn

 

[ngoctrongdat]

Lọc danh sách

Tôi có danh sách tổng hợp của học sinh ở sheet1.
Bạn hãy nêu giúp tôi cách lọc ra danh sách học sinh giỏi ở sheet2; học sinh khá ở sheet3
(như ở file đính kèm)
Tôi muốn khi nhập song các dữ liệu ở sheet1 thì ngay lập tức có được kết quả ở các sheet2 và sheet3; .....

 

[SA_DQ]

Có thể gộp chung trong 1 trang tính thôi, xem thêm trong file kèm theo

Tôi có danh sách tổng hợp của học sinh ở sheet1.
Bạn hãy nêu giúp tôi cách lọc ra danh sách học sinh giỏi ở sheet2; học sinh khá ở sheet3
(như ở file đính kèm)
Tôi muốn khi nhập song các dữ liệu ở sheet1 thì ngay lập tức có được kết quả ở các sheet2 và sheet3; .....

 Option Explicit
Dim Sh As Worksheet, Rng As Range
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, [i1]) Is Nothing Then
   Range([B7], Cells([B65500].End(xlUp).Row, "G")).ClearContents
   GPE_COM
   Sh.Range("i7:N" & Sh.[i65500].End(xlUp).Row).Copy Destination:=[B7]
   Set Sh = Nothing:          Set Rng = Nothing
 End If
End Sub

[B]Sub GPE_COM()[/B]
 Set Sh = Sheets("Lop")
 Set Rng = Sh.Range("B6:G" & Sh.[B65500].End(xlUp).Row)
 Rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sh.Range( _
        "M1:M2"), CopyToRange:=Sh.Range("I6:N6"), Unique:=False
[B]End Sub[/B]

 

[ngoctrongdat]

lọc danh sách

Bạn có thể chỉ dẫn rõ hơn cho tôi về việc sử dụng và viêt các đoạn PH code và code được không? (nhập vào đâu)
File bạn gửi cho tôi chỉ thay đổi được tiêu đề "danh sách HSG" hay "danh sách HSTT" thôi mà chưa có học sinh đi kèm các tiêu đề đó.
Bạn xem và sửa lại cũng như chỉ dẫn thêm. Xin cảm ơn!
(Đi xin nhưng hơi bị "xôi gấc" - trình độ có hạn thông cảm nha!

 

[SA_DQ]

Sao vậy được ta?

Mình vửa tải file đính kèm & vận hành thấy suông sẻ mà!

Bạn thử đến ô màu lam [I1] & cho biết có danh sách nào trong đó không?
Nếu có thì chọn lấy 1 lần lượt xem sao!

 

[ngoctrongdat]

tôi đã làm

Tôi đã làm lại theo bạn chỉ dẫn nhưng sau khi đổi ds ở ô I1 thì kết quả là chỉ có tên tiêu đề thay đổi còn danh sách học sinh trong đó vẫn y nguyên không có thay đổi gì cả!!!!

 

[ndu96081631]

Tôi đã làm lại theo bạn chỉ dẫn nhưng sau khi đổi ds ở ô I1 thì kết quả là chỉ có tên tiêu đề thay đổi còn danh sách học sinh trong đó vẫn y nguyên không có thay đổi gì cả!!!!

Vậy tôi nghĩ có vấn đề với Settings trong Macro Security trên máy bạn rồi!
Bạn cho hỏi: Khi bạn mở file thì bạn nhìn thấy thông báo giống hình nào dưới đây?
Hình 1

Hình 2

Và bạn đã làm gì?
Nếu bạn thấy thông báo giống hình 1 thì đơn giản chỉ cần bấm nút Enable Macros là code chạy được
Nếu bạn nhìn thấy thông báo giống hình 2 thì phải làm tiếp 1 thao tác nữa:
- Vào menu Tools\Macro\Security rồi chọn giống hình dưới đây:

- Sau đó đóng file, mở lại lần nữa, bấm nút Enable Macros
Bạn kiểm tra lại xem

 

[ngoctrongdat]

đã tìm thấy lỗi

Tôi đã tìm ra lỗi và khắc phục được theo chỉ dẫn của ndu96081631.
Bạn có thể chỉ dẫn giúp tôi việc tạo ra macro đó.
Xin cảm ơn!

 

[ndu96081631]

Tôi đã tìm ra lỗi và khắc phục được theo chỉ dẫn của ndu96081631.
Bạn có thể chỉ dẫn giúp tôi việc tạo ra macro đó.
Xin cảm ơn!

Đầu tiên bạn mở file đang chứa macro, bấm Alt + F11 để vào xem người ta viết gì trong đó
Việc tạo ra macro có nhiều cách: Ai rành thì tự viết lấy (cũng Alt + F11 rồi viết vào cửa số này)... Còn ai mới học sẽ dùng chức năng Record macro của Excel trợ giúp (menu Tools\Macro\Record new macro) ---> Nó giống như cái máy thu băng, ta làm sao nó ghi lại tất cả thành code, mai này "nhấn nút" nó làm lại toàn bộ thao tác mà ta đã làm

 

[ngoctrongdat]

Lọc danh sách

Các bạn hãy giúp tôi thiết kế macro như đã làm ở file gửi lần trước theo ý sau:
-Ở sheet 2: dùng để lọc danh sách học sinh theo xếp loại học lực.
-Ở sheet 3: dùng để lọc danh sách học sinh theo danh hiệu thi đua.
Giúp tôi sớm nhé các bạn.
Xôi gấc tí nhé!(Hãy chỉ dẫn giúp cụ thể cách tạo ra các macro đó nhé - chỉ cần 1 cái thôi là có thể tôi sẽ cố nghĩ tiếp) Hi hi ......

 

[ngoctrongdat]

 Option Explicit
Dim Sh As Worksheet, Rng As Range
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, [i1]) Is Nothing Then
   Range([B7], Cells([B65500].End(xlUp).Row, "G")).ClearContents
   GPE_COM
   Sh.Range("i7:N" & Sh.[i65500].End(xlUp).Row).Copy Destination:=[B7]
   Set Sh = Nothing:          Set Rng = Nothing
 End If
End Sub

[B]Sub GPE_COM()[/B]
 Set Sh = Sheets("Lop")
 Set Rng = Sh.Range("B6:G" & Sh.[B65500].End(xlUp).Row)
 Rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sh.Range( _
        "M1:M2"), CopyToRange:=Sh.Range("I6:N6"), Unique:=False
[B]End Sub[/B]

Bạn làm ơn chỉ dẫn giùm tôi nhé. Yêu cầu tôi để trong file đính kèm!
Thank you very much!

 

[ndcnbb]

bạn cho mình xin code giống file devil_2008 trong phần này ko?

http://www.giaiphapexcel.com/forum/showthread.php?14071-Lọc-dữ-liệu-từ-một-sheet-qua-các-sheet-khác&

Mình cần code +hình thức giống file devil làm >> sửa đổi để phục vụ công việc thanks

 

[lamdathoa]

Xin giúp em tạo macro tự động rút trích dữ liệu

Xin chào mọi người,

Mọi người giúp em tạo một cái macro khi nhập dữ liệu đơn đặt hàng vào bảng tổng thì nó tự động rút trích qua các sheet tương ứng bên cạnh.

File đính kèm gồm sheet Total chứa tất cả đơn hàng trong năm. Căn cứ vào cột S - Đơn đặt trong tháng để chép dữ liệu qua các tháng tương ứng. Điều quan trọng là khi em có thêm đơn hàng của tháng mới và tạo thêm sheet mới thì nó tự động rút trích qua đó luôn mà ko cần phải sửa lại code hay gì đó.

Link download: http://loinhac.ucoz.com/load/0-0-0-26-20 (304.2Kb) - direct link

(em upload lên diễn đàn ko đc...nên mới upload qua trang khác. Link trên download trực tiếp, không có quảng cáo).

Rất mong được sự giúp đỡ của mọi người.

Thân
Hoa

 

[sealand]

Đối với file này thì nên để chi tiết tháng vào 1 sheet, khi cần xem tháng nào cứ chọn tháng là có dữ liệu

 

[lamdathoa]

Hi anh,

Mình không thể show dữ liệu ra từng tháng theo sheet sao? Em cũng muốn sửa lại theo ý muốn nhưng không được. Vì mấy ông cấp trên không cho, chỉ show theo tháng qua các sheet.

Em muốn cái code giống như thế này http://www.giaiphapexcel.com/forum/showthread.php?13658-Sửa-giúp-code-để-lọc-dữ-liệu/page2
Khi nhập vào total sẽ tự động rút trích qua sheet tháng. Thanks a!

 

[SA_DQ]

Hãy bấm vô nút cần thiết để có kết quả các tháng

[ThongBao]Hi anh,
Mình không thể show dữ liệu ra từng tháng theo sheet sao? Em cũng muốn sửa lại theo ý muốn nhưng không được. Vì mấy ông cấp trên không cho, chỉ show theo tháng qua các sheet.

Em muốn cái code giống như thế này: Khi nhập vào total sẽ tự động rút trích qua sheet tháng. Thanks a![/ThongBao]

Lần sau bạn nên bỏ bớt nữa dữ liệu trong các tháng: đỡ hao tài nguyên của bạn & mọi người có nhã í giúp bạn!

 

[lamdathoa]

Nó bị lỗi như thế này





Khi nhấn nút chuyển dữ liệu thì nó hiện lỗi bên dưới.



Mặc dù em đã khởi động macro.


Em sửa lại file dữ liệu ẽxcel rồi. Anh xem lại giúp em nha. Bây giờ mình dùng cột Y ( Đơn đặt trong tháng).

Link download: http://loinhac.ucoz.com/load/0-0-0-27-20 (241Kb)

(em xóa bớt một số đơn nhưng vẫn không thể upload lên diễn đàn được - link download là trực tiếp - không có quảng cáo)

Cám ơn anh và mọi người!

 

[sealand]

Hi anh,

Mình không thể show dữ liệu ra từng tháng theo sheet sao? Em cũng muốn sửa lại theo ý muốn nhưng không được. Vì mấy ông cấp trên không cho, chỉ show theo tháng qua các sheet.

Em muốn cái code giống như thế này http://www.giaiphapexcel.com/forum/showthread.php?13658-Sửa-giúp-code-để-lọc-dữ-liệu/page2
Khi nhập vào total sẽ tự động rút trích qua sheet tháng. Thanks a!

Sửa 1 chút là được thôi mà

 

[lamdathoa]

đây là file excel đã chỉnh lại.
http://loinhac.ucoz.com/load/0-0-0-27-20 (direct download) (giúp e tạo VBA vào file này nha).

Em muốn có cái VBA giống như file này attachment bên dưới
http://www.giaiphapexcel.com/forum/attachment.php?attachmentid=15888&d=1222094452

Hix...e cố gắng đọc mấy cái e-book về VBA nhưng ko có những cấu trúc tương tự như vậy và cũng chỉ những cái đơn giản...nhưng lý do lớn nhất là e rất tệ về mấy cái code này..... Hix...giúp em nha.

 

[Quang_Hải]

đây là file excel đã chỉnh lại.
http://loinhac.ucoz.com/load/0-0-0-27-20 (direct download) (giúp e tạo VBA vào file này nha).

Em muốn có cái VBA giống như file này attachment bên dưới
http://www.giaiphapexcel.com/forum/attachment.php?attachmentid=15888&d=1222094452

Hix...e cố gắng đọc mấy cái e-book về VBA nhưng ko có những cấu trúc tương tự như vậy và cũng chỉ những cái đơn giản...nhưng lý do lớn nhất là e rất tệ về mấy cái code này..... Hix...giúp em nha.

Bạn dùng thử 2 code này

Tạo 1 module và copy code này vào

Sub loc()
If ActiveSheet.Name <> "Total" Then
   With ActiveSheet
      .[Y1].Value = .[y3]
      .[Y2].Value = .Name
   End With
   With Sheets("Total")
      .[A3:Y65000].AdvancedFilter 2, [Y1:Y2], [A3:Y3]
   End With
End If
End Sub

Sau đó copy code này vào Thisworkbook

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
loc
End Sub

 

[Quang_Hải]

Thôi gởi file luôn cho bạn cho chắc ăn, nếu không lại mất công trả lời nữa.

PS: Nhưng thật tình mà nói không ai lại tạo ra cả đống sheet như thế. Đúng là...