Nhờ viết sub lọc dữ liệu từ nhiều sheet

Liên hệ QC

TrungChinhs

Thành viên tích cực
Tham gia
18/2/08
Bài viết
1,475
Được thích
2,469
Nghề nghiệp
Công chức
Chào các bạn ! mình cần được giúp đỡ về viết sub lọc dữ liệu từ nhiều sheet với yêu cầu như sau: Có 1 file gồm nhiều Sheet (A), Sheet (B), Sheet (C), Sheet (…), và cuối cùng là Sheet (TongHop),
Mình muốn từ Sheet TongHop có một InBox để nhập điều kiện lọc, sau khi nhấn OK thì dữ liệu lọc từ các Sheet được đưa vào sheet(TongHop).

Nếu làm bằng tay thì như sau: dùng Autofilter lọc sheet(A), copy dữ liệu paste sang sheet(TongHop), tiếp đó lọc sheet(B) copy sang dán tiếp vào sheet(TongHop)…
giả định các bảng nguồn trong các sheet là giống nhau. Dữ liệu giả lập trong file đính kèm.

Rất mong các bạn quan tâm giúp đỡ, Xin cảm ơn !
 

File đính kèm

Nhờ sửa code lọc dữ liệu

Yêu cầu của đoạn code sau là dùng Autofilter lọc dữ liệu từ các Sh nguồn, Copy kết quả paste vào Sheet TongHop sau đó tắt Autofilter trả bảng nguồn về trạng thái ban đầu. Nếu viết như dưới đây thì kết quả chỉ đúng khi không tắt Autofilter. Vậy phải đặt lệnh .Cells.AutoFilter vào chỗ nào trong đoạn code này hay phải sửa code như thế nào để đạt được yêu cầu trên. Nhờ các bạn sửa giúp (Mình đã thử rất nhiều cách nhưng không được). Xin cảm ơn !

Mã:
  Sub LocSheet()
  Dim Sh As Worksheet, VungDK As Range, Cell As Range
  Dim i As Byte, ri As Long, Rd As Long
  [D4:M65536].ClearContents
  Rd = 4: [D3].FormulaR1C1 = ". "
  For Each Sh In Worksheets
          With Sh
              If .Name <> "DS" And .Name <> "TongHop" And .Name <> "DsHo" And .Name <> "MH" Then
                  Rw = .[F65536].End(xlUp).Row
                  ri = .[F65536].End(xlUp).Row
                       .Columns("C:C").ClearContents
                      If Rw > 1 Then
                          Set VungDK = .Range("C4:C" & Rw)
                              For Each Cell In VungDK
                                  Cell.FormulaR1C1 = "=IF(RC[2]=0,OFFSET(RC4,-1,-1),IF(ISERROR(VLOOKUP(RC5,DS!C2,1,0)),"""",RC4))"
                                  Cell.Value = Cell
                              Next
                      End If
                          .Cells.AutoFilter Field:=3, Criteria1:="<>"
                          .Range("D4:M" & Rw).Copy
                          Rd = Sheets("TongHop").[D65536].End(xlUp).Row + 1
                          Sheets("TongHop").Range("D" & Rd).PasteSpecial Paste:=xlPasteValues
                          [COLOR=Red][B]'.Cells.AutoFilter     [/B][COLOR=Blue]' không tắt [/COLOR][/COLOR][COLOR=Blue]AutoFilter[/COLOR]
                          .Columns("C:C").ClearContents
                          Range("D4").Select
              End If
                          Set VungDK = Nothing: Set Cell = Nothing
          End With
  End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Chào bạn tôi là tuanlichviet tôi đã tải file của bạn nhờ bạn gửi cho tôi 1 file có code có thể mở rộng vùng trích lọc dữ liệu từ nhiều bảng sang sổ tổng hợp
 
Upvote 0
Chào Tuanlichviet File ví dụ tại bài 18 (trang2) bạn copy đoạn code này dán đè lên đoạn code cũ. Thanks!
 
Upvote 0
PHP:
Sheets("TongHop").Range("D" & Rd).PasteSpecial Paste:=xlPasteValues
                          '.Cells.AutoFilter     ' không tắt AutoFilter
Ban đổi như sau, Sheets("TongHop").AutoFilterMode=False
PHP:
Sheets("TongHop").Range("D" & Rd).PasteSpecial Paste:=xlPasteValues
                           Sheets("TongHop").AutoFilterMode=False

Tôi đã làm cho bạn rồi mà, dùng thử đi.
 
Upvote 0
@ bác ThuNghi em đã thử nhưng không được.
[FONT=&quot]ý em muốn hỏi là làm thế nào tắt được AutoFilter tại các bảng nguồn mà kết quả lọc vẫn đúng ?[/FONT]
Trong bài đưa ra phải bỏ câu lệnh .Cells.AutoFilter (tức là không tắt AutoFilter) thì mới lọc được. Rất mong bác xem lại giúp. Thanks!
 
Upvote 0
PHP:
With Sh
...
.Cells.AutoFilter Field:=3, Criteria1:="<>" 'Nếu như vậy thì bỏ AutoFilter như sau
                          .Range("D4:M" & Rw).Copy
                          Rd = Sheets("TongHop").[D65536].End(xlUp).Row + 1
                          Sheets("TongHop").Range("D" & Rd).PasteSpecial Paste:=xlPasteValues
                           .Cells.AutoFilterMode = False     ' không tắt AutoFilter

Bạn dùng câu lệnh:

.Cells.AutoFilterMode = False
 
Upvote 0
PHP:
Sub Loc()
Sub Loc()
  Dim Rng As Range, BlankRng As Range, Des As Range
  On Error Resume Next
  Application.ScreenUpdating = False
  Set Rng = [A6].CurrentRegion: Rng.Interior.ColorIndex = 36
  Set BlankRng = Rng.Offset(, 3).Resize(, 1).SpecialCells(4)
  'Dien vao cac ô rong
  For i = 1 To BlankRng.Areas.Count
    With BlankRng.Areas(i)
      .Value = .Offset(-1).Resize(1).Value
    End With
  Next
  'Loc sang
  [F6].CurrentRegion.Clear
  Rng.AdvancedFilter Action:=1, CriteriaRange:=[E1:E2]
  BlankRng.ClearContents  '<=== Xoa du lieu da fill
  Rng.SpecialCells(12).Copy Destination:=[F6]
  Sheet1.ShowAllData
  BlankRng.ClearContents '<=== Xoa du lieu da fill
  Set Des = [F6].CurrentRegion
  Des.Interior.ColorIndex = 36
End Sub

Em chưa biết về phương thức Areas, em xin phép hỏi: BlankRng.Areas.Count khác gì BlankRng.Count?
----------
Em Test thử và em đã hiểu rồi ah, xin cảm ơn mọi người
 
Lần chỉnh sửa cuối:
Upvote 0
Em chưa biết về phương thức Areas, em xin phép hỏi: BlankRng.Areas.Count khác gì BlankRng.Count?
----------
Em Test thử và em đã hiểu rồi ah, xin cảm ơn mọi người
Một vùng dữ liệu bao gồm nhiều vùng nhỏ không nằm liền nhau thì mỗi vùng nhỏ ấy được xem là 1 Area ---> Areas.Count là tổng số các khu vực
Giống bài này:
http://www.giaiphapexcel.com/forum/showthread.php?62898-Dùng-câu-lệnh-gì-để-trả-về-địa-chỉ-của-1-Range
Kết quả của BlankRng sẽ là vùng D8:D12, D14:D18... Vùng này gồm 2 Area: D8:D12 và D14:D18 ---> Vậy trong trường hợp này Areas.Count sẽ = 2
----------------
Còn đương nhiên BlankRng.Count là tổng số cell của BlankRng
 
Upvote 0
Trong bài này em chưa hiểu được dòng cuối, nhờ các thày giúp cho ah:
PHP:
Option Explicit
Sub Loc()
  Dim Rng As Range, BlankRng As Range, Des As Range, Clls As Range
  Dim i As Long, j As Long
  On Error Resume Next
  Application.ScreenUpdating = False
  Set Rng = [A6].CurrentRegion
  Set BlankRng = Rng.Offset(, 3).Resize(, 1).SpecialCells(4)
  'Fill các cell rổng
  For i = 1 To BlankRng.Areas.Count
    With BlankRng.Areas(i)
      .Value = .Offset(-1).Resize(1).Value
    End With
  Next
  'Lọc sang
  [F6].CurrentRegion.Clear
  Rng.AdvancedFilter Action:=1, CriteriaRange:=[E1:E2]
  BlankRng.ClearContents  '<=== Xóa dử liệu đã fill
  Rng.SpecialCells(12).Copy Destination:=[F6]
  Sheet1.ShowAllData
  BlankRng.ClearContents '<=== Xóa dử liệu đã fill
  Set Des = [F6].CurrentRegion
  Điền số thứ tự
  For Each Clls In Des.Offset(1, 1).Resize(, 1).SpecialCells(2, 23).Offset(, -1)
    Clls = j + 1: j = j + 1
  Next
End Sub

----------
Tại sao địa chỉ của Range: Des.Offset(1, 1).Resize(, 1).SpecialCells(2, 23).Offset(, -1) lại là F7, F13, F19?
SpecialCells(2, 23) là gì?
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Bài toán này nếu không sử dụng các tính năng của AdvancedFilter thì hướng đi của thuật toán sẽ như thế nào nhỉ?
 
Upvote 0
Ta mò dần thôi, như sau:

Tại sao địa chỉ của Range: Des.Offset(1, 1).Resize(, 1).SpecialCells(2, 23).Offset(, -1) lại là F7, F13, F19?
SpecialCells(2, 23) là gì?

Đầu tiên, ta cần biết Des; (như khai báo ban đầu sẽ là đối tượng vùng) Vậy nó là vùng miền nào? Hơn nữa, là biến đối tượng nên nó fải được gán bằng từ khoá Set; Nó đây:
Mã:
[COLOR=#000000][COLOR=#0000BB]Set Des [/COLOR][COLOR=#007700]= [[/COLOR][COLOR=#0000BB]F6[/COLOR][COLOR=#007700]].[/COLOR][COLOR=#0000BB]CurrentRegion[/COLOR][/COLOR]

Như vậy
, cụ thể nó là vùng F6:I22 trên traqng tính của chúng ta;

Tiếp theo là fương thức Ofset(1,1) (được tô màu đỏ); Fương thức này sẽ làm dịch chuyển vùng chọn sang fải 1 cột & xuống dưới 1 hàng ;
(Nghĩa là sau fương thức này sẽ là vùng G7:J23)

Tiếp nữa là fương thức Resize(..,..)
. . . .
Các fương thức này hầu như có những bài tổng quan trên diễn đàn (kể cả SpecialCells, CurentRegion)
Bạn muốn chinh fục VBA, bạn nhất thiết fải tìm chúng & nghiền ngẫm.

Chúc sớm thành công!
 
Upvote 0
Cảm ơn bác ChanhTQ trong Code
PHP:
Des.Offset(1, 1).Resize(, 1).SpecialCells(2, 23).Offset(, -1)
những phần trước em hiểu nó là gì, chỉ riêng cái SpecialCells(2, 23).Offset(, -1) là em chưa phân tích được nó thôi.

Tức em chưa đoán được số 2, 23 trong SpecialCells(2, 23) nó phản ánh cái gì (cách dùng ntn) ?
----------
Các bác cho em hỏi bài này nếu không dùng AdvancedFilter thì thuật toán nó sẽ đi thế nào nhỉ?
(Xin chỉ cần gợi ý hướng đi thôi ah)


 
Upvote 0
Cảm ơn bác ChanhTQ trong Code
PHP:
Des.Offset(1, 1).Resize(, 1).SpecialCells(2, 23).Offset(, -1)
những phần trước em hiểu nó là gì, chỉ riêng cái SpecialCells(2, 23).Offset(, -1) là em chưa phân tích được nó thôi.

Tức em chưa đoán được số 2, 23 trong SpecialCells(2, 23) nó phản ánh cái gì (cách dùng ntn) ?
----------
Các bác cho em hỏi bài này nếu không dùng AdvancedFilter thì thuật toán nó sẽ đi thế nào nhỉ?
(Xin chỉ cần gợi ý hướng đi thôi ah)


SpecialCells(2, 23) tương đương với thao tác: Ctrl + G\Special rồi check mục Contains với 4 mục phụ Numbers, Text, Logicals, Errors đều được check hết ---> Record macro thao tác trên sẽ có được code này
Tức chọn các cell chứa dữ liệu (không phải công thức và không rổng)...
Chọn xong rồi, dịch sang trái 1 cột (Offset(,-1)
Thế thôi
Ngoài ra, SpecialCells(2, 23) có thể viết gọn thành SpecialCells(2) cũng được
 
Upvote 0
Th­ưa thày khi chọn Ctrl+G, tính chất SpecialCells(xlCellType...) thì xlCellType... trong các Code VBA thường viết tắc là số (= Số thứ tự theo chiều đi từ trên xuống dưới, từ trái sang phải) ?

Ví dụ:
Chọn Constants thì có thể viêt là SpecialCells(2)
Chọn Blanks thì viết tắt là SpecialCells(4)
Chọn Object thì viết tắt là SpecialCells(7)
.....
Nếu theo quy luật trên em đếm như vậy thì xlCellTypeVisible nó phải là 13 tức SpecialCells(13) chứ. Nhưng sao em thấy kết quả thực tế xlCellTypeVisible lại là 12 tức SpecialCells(12)?
 
Upvote 0
Th­ưa thày khi chọn Ctrl+G, tính chất SpecialCells(xlCellType...) thì xlCellType... trong các Code VBA thường viết tắc là số (= Số thứ tự theo chiều đi từ trên xuống dưới, từ trái sang phải) ?

Ví dụ:
Chọn Constants thì có thể viêt là SpecialCells(2)
Chọn Blanks thì viết tắt là SpecialCells(4)
Chọn Object thì viết tắt là SpecialCells(7)
.....
Nếu theo quy luật trên em đếm như vậy thì xlCellTypeVisible nó phải là 13 tức SpecialCells(13) chứ. Nhưng sao em thấy kết quả thực tế xlCellTypeVisible lại là 12 tức SpecialCells(12)?

Cha Bill quy định sao thì mình xài vậy thôi chứ tôi đâu có biết!
Đôi lúc cũng phải có vài cái ngoại lệ chứ
Ẹc... Ẹc...
 
Upvote 0
Web KT

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

Back
Top Bottom