Làm thế nào lọc dữ liệu duy nhất từ 3 sheet vào sheet tổng hợp (1 người xem)

[Phanhanhdai]

Thưa các anh chị trên diễn đàn, nhờ học hỏi được mọi người trên diễn đàn giờ em đã có thể tự tổng hợp lọc số liệu từ 1 sheet này sang sheet kia. Thực tế công việc của em đòi hỏi làm thế nào để tổng hợp dữ liệu từ 3 sheet vào 1 sheet tổng hợp (sheet!TH), toàn bộ dữ liệu của em dạng ngày tháng năm (dd/mm/yyyy), làm sao thoả mãn cột A của sheet!TH chứa tất cả các tên của cột A của 3 sheet kia (Sheet!1,sheet!2, sheet!3) và đảm bảo điều kiện những ô giống nhau chỉ lấy một số liệu duy nhất. Vì công việc cuối năm của em cần rất gấp, kính mong các anh chị trên diễn đàn giúp cho, xin đa tạ mọi ngưòi.

 

[ThiNgu]

Thưa các anh chị trên diễn đàn, nhờ học hỏi được mọi người trên diễn đàn giờ em đã có thể tự tổng hợp lọc số liệu từ 1 sheet này sang sheet kia. Thực tế công việc của em đòi hỏi làm thế nào để tổng hợp dữ liệu từ 3 sheet vào 1 sheet tổng hợp (sheet!TH), toàn bộ dữ liệu của em dạng ngày tháng năm (dd/mm/yyyy), làm sao thoả mãn cột A của sheet!TH chứa tất cả các tên của cột A của 3 sheet kia (Sheet!1,sheet!2, sheet!3) và đảm bảo điều kiện những ô giống nhau chỉ lấy một số liệu duy nhất. Vì công việc cuối năm của em cần rất gấp, kính mong các anh chị trên diễn đàn giúp cho, xin đa tạ mọi ngưòi.

Theo ngu ý của em thì dùng cách sau không biết có được không nhé. Mình copy toàn bột cột A của các sheet vào cột B sheet tổng hợp (sheet!TH) sau đó mình dùng advance filter để tạo ra danh sách duy nhất, hình như là đáng dấu vào unique record only.
Hy vọng các anh chị giúp đỡ cho ách nào tối ưu.

 

[ChanhTQ@]

Và đây là macro thực thi những điều ThiNgu gợi í

Option Explicit
Sub CopyToSheet()
 Dim Sh As Worksheet
 Dim eRw As Long, Rng As Range
 
 ThisWorkbook.Worksheets("TH").Select
 [A1].Resize(, 2).Value = "Ngày"
 For Each Sh In ThisWorkbook.Worksheets
   If Sh.Name <> "TH" Then
      eRw = Sh.[A65500].End(xlUp).Row
      Set Rng = Sh.[A1].End(xlDown)
      With [B65500].End(xlUp)
         Range(Rng, Rng.End(xlDown)).Copy Destination:=.Offset(1)
      End With
   End If
 Next Sh
 Columns("B:B").Select
 Selection.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
   "A1"), Unique:=True
 Columns("B:B").Delete
End Sub

Chúc vui vẽ nhân cuôí tuần!

 

[Dauthivan]

Cảm ơn các anh về các phương pháp đưa ra, để xử lý theo cách thủ công (tức lọc advance filter) thì em cũng có thể làm được, nhưng em đang đầu tư thời gian nghiên cứu về mảng (name) nhưng suy nghĩ mãi mà không làm được theo phương pháp này. Em không biết có giải quyết được bài toán theo cách này không?

 

[ThiNgu]

Cảm ơn các anh về các phương pháp đưa ra, để xử lý theo cách thủ công (tức lọc advance filter) thì em cũng có thể làm được, nhưng em đang đầu tư thời gian nghiên cứu về mảng (name) nhưng suy nghĩ mãi mà không làm được theo phương pháp này. Em không biết có giải quyết được bài toán theo cách này không?

Sau khi nghiên cứu các bài của Thầy NDU và Thầy Mỹ về mảng và mình làm thử code sau, nếu sai xin đừng cười cho thành viên mới nhé.

Sub CopyToShArr()
 Dim Sh As Worksheet
 Dim eRw As Long, Rng As Range, iR As Long
 Dim WF As WorksheetFunction, Arr(), Dic As Object
 Set WF = WorksheetFunction: Set Dic = CreateObject("Scripting.Dictionary")
 ThisWorkbook.Worksheets("TH").Select
 [B1].Value = "Ngày"
 For Each Sh In ThisWorkbook.Worksheets
   If Sh.Name <> "TH" Then
      eRw = Sh.[A65500].End(xlUp).Row
      Set Rng = Sh.[A1].End(xlDown)
      Set Rng = Range(Rng, Rng.End(xlDown))
      Arr = WF.Transpose(Rng.Value)
      For iR = 1 To UBound(Arr)
        If Len(Arr(iR)) > 0 Then
          If Not Dic.Exists(Arr(iR)) Then
            Dic.Add Arr(iR), Nothing
          End If
        End If
      Next iR
    End If
 Next Sh
 If Dic.Count > 0 Then
  With [B2]
    .Resize(65000, 1).Clear
    With .Resize(Dic.Count, 1)
      .NumberFormat = "dd/mm/yyyy"
      .Value = WF.Transpose(Dic.keys)
    End With
  End With
 End If
Set Rng = Nothing: Set WF = Nothing: Set Dic = Nothing
Erase Arr
End Sub

Thú thật, tôi ghét mấy bạn ghê, mình mới tập viết code, xem xong có được hay không thì cũng cho biết, hay cám ơn hay chửi 1 câu cũng chả thấy.