Thách đố về trích lọc danh sách duy nhất từ 2 vùng khác nhau và ghép lại (1 người xem)

[ndu96081631]

Thừa thắng xong lên: Lọc 1 phát toàn bộ các sheet và đặt kết quả vào cột F của sheet cuối cùng (đồng thời sort luôn kết quả)

Option Explicit
Sub Loc()
   Dim i, Er As Long
   Application.ScreenUpdating = False
   With Range("E1")
     .Value = "TEN"
     .HorizontalAlignment = xlCenter
     .Font.Bold = True
   End With
   For i = 1 To ThisWorkbook.Worksheets.Count
     Er = [E65000].End(xlUp).Row + 1
     Sheets(i).[A1].CurrentRegion.Copy Destination:=Range("E" & Er)
   Next
   Range("E1:E" & Er - 1).AdvancedFilter Action:=1, Unique:=1
   Range("E1:E" & Er - 1).SpecialCells(xlCellTypeVisible).Copy Destination:=[F1]
   ActiveSheet.ShowAllData
   Columns("E:E").ClearContents
   [F1].CurrentRegion.Sort Key1:=Range("F2"), Order1:=1, Header:=1
   Application.ScreenUpdating = True
End Sub

Code cũng ngắn tí tẹo

 

[Mr Okebab]

Công đoạn chép tốn hay AdvcedFilter tốn xăng hơn thì mình chưa có thông tin!

Thử với các Sheet gồm có 30.000 hàng (vì E2003 chỉ có 65.000 hàng thôi, có chỗ để copy), 2 cột, và khoảng 10 sheet thì biết ngay thôi mà.

(Xem File VD để thử)

Em thì lại cứ tưởng bác SA trình bày tuyệt chiêu UDF của bác cơ, chứ mấy cái Sub thì nói làm gì.

Thân!

 

[ndu96081631]

-Thứ nhất: Mình không có tham vọng thi đấu tốc độ với bác Sa (nhất là về phần VBA)
-Thứ hai: Mình muốn đưa ra 1 giãi pháp đơn giản nhất mà ai ai cũng hiểu được (nhất là các thành viên mới tập tành
-Thứ ba: Mình không dám nói code của bác Sa không hay, nhưng rõ ràng nó quá cao cấp, phải ở 1 trình độ nhất định nào đó mới hiểu được
Vậy nên: Hãy vọc với những gì đơn giãn dể hiểu nhất, sau đó hẳn tính nhé!

 

[hoangdanh282vn]

Em cũng không biết nữa, nhưng em thấy code em ngắn có tí tẹo và ít rắc rối hơn (dể hiểu)

Sub Loc()
    Er1 = [A65536].End(xlUp).Row
    Range("A1:A" & Er1).Copy Destination:=[E1]
    Er2 = Sheet1.[A65536].End(xlUp).Row
    Er3 = [E65536].End(xlUp).Row + 1
    Sheet1.Range("A2:A" & Er2).Copy Destination:=Range("E" & Er3)
    Er4 = Sheet2.[E65536].End(xlUp).Row
    Range("E1:E" & Er4).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    Range("E1:E" & Er4).SpecialCells(xlCellTypeVisible).Copy Destination:=[F1]
    ActiveSheet.ShowAllData
    Columns("E:E").ClearContents
    Range("F1").Select
End Sub

Bác tiến bộ mau quá làm em theo không kịp.
Em insert thêm 1 sheet ở giữa, nếu thêm dữ liệu vào sheet này, bắt đầu từ cell A1, A2.. thì code chạy đúng, nếu A1 trống, A5 có thì chạy chưa đúng Bác à

 

[ndu96081631]

Bác tiến bộ mau quá làm em theo không kịp.
Em insert thêm 1 sheet ở giữa, nếu thêm dữ liệu vào sheet này, bắt đầu từ cell A1, A2.. thì code chạy đúng, nếu A1 trống, A5 có thì chạy chưa đúng Bác à

Oh... cái này chỉ là ví dụ gợi ý thôi mà bạn!
Việc lọc đương nhiên phải dựa vào dử liệu gốc: Ở đây tôi giả sữ rằng dử liệu không có dòng rổng và bắt đầu từ dòng 1 luôn! (và cũng đương nhiên các sheet có cấu trúc giống nhau)
Đặt trường hợp dử liệu bắt đầu từ dòng 2, còn dòng 1 là TIÊU ĐỀ thì ta không dùng CurrentRegion được! Sửa lại tí bằng cách dùng 1 đoạn code tìm dòng cuối cùng có dử liệu ở các sheet là xong chứ gì: (Er2 = Sheets(i)......)

Option Explicit
Sub Loc()
   Dim i, Er1, Er2 As Long
   Application.ScreenUpdating = False
   [A1].Copy Destination:=[E1]
   For i = 1 To ThisWorkbook.Worksheets.Count
     Er1 = [E65000].End(xlUp).Row + 1
     Er2 = Sheets(i).[A65536].End(xlUp).Row
     Sheets(i).Range("A2:A" & Er2).Copy Destination:=Range("E" & Er1)
   Next
   Range("E1:E" & Er1 - 1).AdvancedFilter Action:=1, Unique:=1
   Range("E1:E" & Er1 - 1).SpecialCells(xlCellTypeVisible).Copy Destination:=[F1]
   ActiveSheet.ShowAllData
   Columns("E:E").ClearContents
   [F1].CurrentRegion.Sort Key1:=Range("F2"), Order1:=1, Header:=1
   Application.ScreenUpdating = True
End Sub

Các bạn tự mình chế biến thêm cho phù hợp với dử liệu của mình
Như tôi đã nói ở trên: Chúng ta sẽ đi từ dể đến khó, nếu thấy có vấn đề thì ta cùng nhau tiếp tục phát triển

 

[anhtuan1066]

Phát triển tiếp bài toán này trong trường hợp dử liệu có dòng rổng, ta dùng: SpecialCells(xlCellTypeConstants, 23)

Option Explicit
Sub Loc()
   Dim i, Er1, Er2 As Long
   Application.ScreenUpdating = False
   Columns("F:F").ClearContents
   [A1].Copy Destination:=[IV1]
   For i = 1 To ThisWorkbook.Worksheets.Count
     Er1 = [IV65000].End(xlUp).Row + 1
     Er2 = Sheets(i).[A65536].End(xlUp).Row
     Sheets(i).Range("A2:A" & Er2).SpecialCells(xlCellTypeConstants, 23).Copy Destination:=Range("IV" & Er1)
   Next
   Range("IV1:IV" & Er1 - 1).AdvancedFilter Action:=1, Unique:=1
   Range("IV1:IV" & Er1 - 1).SpecialCells(xlCellTypeVisible).Copy Destination:=[F1]
   ActiveSheet.ShowAllData
   Columns("IV:IV").ClearContents
   [F1].CurrentRegion.Sort Key1:=Range("F2"), Order1:=1, Header:=1
   Application.ScreenUpdating = True
End Sub

(Tôi chuyển cột tạm E sang IV để ko ảnh hưởng đến dử liệu thật)

 

[hoangdanh282vn]

Phát triển tiếp bài toán này trong trường hợp dử liệu có dòng rổng, ta dùng: SpecialCells(xlCellTypeConstants, 23)

Bác làm hay quá, Bác cho hỏi về ý nghĩa của con số 23 nhé.
Tuy nhiên, xem xét code của Bác thì em thấy có vấn đề sau : Bác copy toàn bộ dữ liệu từ các sheet vào chung một cột, sau đó mới trích lọc duy nhất và sort, như thế sẽ gây lỗi nếu dữ liệu sau khi Paste > 65536. Và sẽ làm giảm đi tốc độ xử lý.
Em làm một cách khác, chắc sẽ gọn và nhanh hơn :

Option Explicit
Sub Loc()
    Dim i, j, sh As Byte
    Dim r1, r2 As Long
    sh = Sheets.Count
    Range("C:C").ClearContents
    For i = 1 To sh
        r1 = Sheets(i).[A65500].End(xlUp).Row
        r2 = Sheets(sh).[C65500].End(xlUp).Row
        Sheets(i).Range("A1:A" & r1).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets(sh).Range("C" & r2 + 1), Unique:=True
    Next
    Range("C2:C65500").Sort Key1:=Range("C2"), Order1:=xlAscending
    For j = 1 To r2
        If Cells(j, 3) = Cells(j + 1, 3) Then Cells(j + 1, 3).Delete Shift:=xlUp
    Next
    [c1].Value = "Ket Qua"
End Sub

hay cách khác :

Option Explicit
Sub Loc2()
    Dim i, j, sh As Byte
    Dim r1, r2 As Long
    sh = Sheets.Count
    Range("C:C").ClearContents
    For i = 1 To sh
        r1 = Sheets(i).[A65500].End(xlUp).Row
        r2 = Sheets(sh).[C65500].End(xlUp).Row
        Sheets(i).Range("A1:A" & r1).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets(sh).Range("C" & r2 + 1), Unique:=True
        Sheets(sh).Cells(r2 + 1, 3).Clear
    Next
    Range("C2:C65500").Sort Key1:=Range("C2"), Order1:=xlAscending
    [c1].Value = "Ket Qua"
End Sub

 

[SA_DQ]

(Tôi chuyển cột tạm E  sang IV để ko ảnh hưởng đến dử liệu thật)

Chưa thật chắc như bắp đâu! Lỡ người dùng cuối hay 1 ai đó xài thậm chi 1 ô 'IV1' rồi thì sao đây?! Mà thường đó là những dữ liệu quý mới chết chứ! Có quý mới cất chổ khó tìm như vậy.
Như vậy đẻ ra vấn đề phải kiểm xem cột cuối có dữ liệu không nữa mới hoàn chỉnh!
Để không vô vòng kim cô này, chúng ta nên thêm 1 cột 'A'; Sẽ có 2 trường hợp sảy ra:
* Không thêm được : Tìm cách khác;
* Thêm được thì làm tới!
2uan trọng của giải pháp này: Hãy giành phần thiệt thòi về cho mình & nhường khách hàng thuận lợi tối đa!!!

 

[Mr Okebab]

Chưa thật chắc như bắp đâu! Lỡ người dùng cuối hay 1 ai đó xài thậm chi 1 ô 'IV1' rồi thì sao đây?! Mà thường đó là những dữ liệu quý mới chết chứ! Có quý mới cất chổ khó tìm như vậy.
Như vậy đẻ ra vấn đề phải kiểm xem cột cuối có dữ liệu không nữa mới hoàn chỉnh!
Để không vô vòng kim cô này, chúng ta nên thêm 1 cột 'A'; Sẽ có 2 trường hợp sảy ra:
* Không thêm được : Tìm cách khác;
* Thêm được thì làm tới!
2uan trọng của giải pháp này: Hãy giành phần thiệt thòi về cho mình & nhường khách hàng thuận lợi tối đa!!!

Có lẽ Add new sheet, copy tạm vào đó, sau khi xong thì xóa đi.

Theo thiển ý của em, đây chỉ là 1 công đoạn NHỎ trong một bài toán TO, vì vậy phải căn cứ vào từng bài toán cụ thể thì mới biết được.
Chính vì chỉ là một VD nhỏ nên cũng không nên đi sâu quá vào giải thuật vì sự chênh lệch không có nhiều, quanh quẩn cũng chỉ là dựa vào Copy và Advanced Filter thôi.
Chúng ta chỉ xem xét khi có những phát kiến mới (dĩ nhiên là tốc độ cũng tạm được)


Thân!

 

[anhtuan1066]

Bác làm hay quá, Bác cho hỏi về ý nghĩa của con số 23 nhé.

Cái này dể lắm, bạn làm thí nghiệm như sau:
1> Tạo 1 vùng dử liệu có đủ thứ: Number, Text, Logic và Error
2> Bật chức năng record macro
3> Chọn vùng vùng tạo, Ctrl + G, chọn Constant và Numbers
4> Tiếp tục chon vùng, Ctrl + G, chọn Constant và Text
5> Tiếp tục chon vùng, Ctrl + G, chọn Constant và Logics
6> Tiếp tục chon vùng, Ctrl + G, chọn Constant và Errors
7> Tắt Record và xem code
Bạn sẽ thấy Excel quy định rằng:
1> Cell có chứa Number là SpecialCells(xlCellTypeConstants, 1)
2> Cell có chứa Text là SpecialCells(xlCellTypeConstants, 2)
3> Cell có chứa Logic là SpecialCells(xlCellTypeConstants, 4)
4> Cell có chứa Errorlà SpecialCells(xlCellTypeConstants, 16)
Vậy nếu ta check hết vào các mục Numbers, Text, Logics và Errors thì có phải tham số ấy chính là 1 + 2 + 4 + 16 = 23
He... he...
Tương tự như thế bạn tự tính toán trong các trừong hợp khác

 

[tuvn254]

Phong độ Bác vẫn như xưa. Bác làm hay lắm.
Đúng là chiều qua có bạn hỏi mình về vấn đề này, sáng ra mới ra câu đố ai ngờ Bác đã làm xong từ sớm.
Mình xin gửi 1 cách khác, trích và gộp từ 3 vùng khác nhau. và theo logic sẽ áp dụng cho 4 hay 5 vùng cũng được.

nhưng cái này là bác dùng VBA hay dùng hàm vậy bác, e vẫn chưa hiểu kú pháp của hàm này.Nhờ bác giải thích dùm.

 

[hoangdanh282vn]

nhưng cái này là bác dùng VBA hay dùng hàm vậy bác, e vẫn chưa hiểu kú pháp của hàm này.Nhờ bác giải thích dùm.

Bài số 6 là mình dùng công thức mảng kết hợp với name động. Bạn vào Insert\Name để xem các name và công thức chứa trong nó.
Bài 27 mình mới viết bằng VBA

 

[tuvn254]

Bài số 6 là mình dùng công thức mảng kết hợp với name động. Bạn vào Insert\Name để xem các name và công thức chứa trong nó.
Bài 27 mình mới viết bằng VBA

bác giúp e trích lọc file này nhé, mà không dùng VBA (công thức càng đơn giản càng tốt)
Thanks pác nhiều.

 

[hoangdanh282vn]

bác giúp e trích lọc file này nhé, mà không dùng VBA (công thức càng đơn giản càng tốt)
Thanks pác nhiều.

File bạn có virus. Bạn quét rồi gửi lại hay gửi qua mail cho mình cũng được

 

[TKT]

nhờ bạn giúp dùm mình nhé

Bài này bạn hỏi rồi mà, bạn chú ý hỏi ở một topic thôi nha!
http://www.giaiphapexcel.com/forum/showthread.php?t=12746

 

[hoangdanh282vn]

nhờ bạn giúp dùm mình nhé

BẠn xem file đính kèm nha, vào INSERT\NAME để xem công thức