Xin GPE trợ giúp về lọc, xuất dữ liệu trùng nhiều sheet sang 1 sheet tổng hợp

[djlmah]

Cần mọi người giúp đỡ ạ.

E đang cần tổng hợp dữ liệu 1 file mà có nhiều sheet sang 1 sheet để lấy số liệu. Sheet tổng hợp sẽ tổng hợp các dữ liệu từ các sheet con (kể cả các dữ liệu có tên trùng nhau) trả về 1 bảng có số liệu cần tổng hợp.
Mong mọi người giúp đỡ a.

 

[Hai Lúa Miền Tây]

Cần mọi người giúp đỡ ạ.

E đang cần tổng hợp dữ liệu 1 file mà có nhiều sheet sang 1 sheet để lấy số liệu. Sheet tổng hợp sẽ tổng hợp các dữ liệu từ các sheet con (kể cả các dữ liệu có tên trùng nhau) trả về 1 bảng có số liệu cần tổng hợp.
Mong mọi người giúp đỡ a.

Dùng code nhé

Sub LayDL()
    Dim cnn As Object, rst As Object
    Set cnn = CreateObject("ADODB.Connection")
    cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
             "Data Source=" & ThisWorkbook.FullName & ";" & _
             ";Extended Properties=""Excel 8.0;HDR=No;"";"
    With Sheets("TongHop")
        Set rst = cnn.Execute("SELECT F1,F5,F6 FROM [D1$B9:G100] where F1='" & .[C2] & "' " & _
                    "union all SELECT F1,F5,F6 FROM [D2$B9:G100] where F1='" & .[C2] & "' " & _
                    "union all SELECT F1,F5,F6 FROM [D3$B9:G100] where F1='" & .[C2] & "'")
        .[B6:D100].ClearContents
        .[B6].CopyFromRecordset rst
    End With
End Sub

 

[djlmah]

Cám ơn anh Hailua
E muốn làm với nhiều sheet thì sao?( tầm 30 sheet) @hailua. thì code thay đổi như nào ạ file test nên e chỉ để 3sheet.
Và nếu xóa 1 sheet thì lại phải sửa code theo. Có cách nào thêm bớt sheet mà code vẫn dùng được ko a.

 

[seikoqn]

Cám ơn anh Hailua
E muốn làm với nhiều sheet thì sao?( tầm 30 sheet) @hailua. thì code thay đổi như nào ạ file test nên e chỉ để 3sheet.
Và nếu xóa 1 sheet thì lại phải sửa code theo. Có cách nào thêm bớt sheet mà code vẫn dùng được ko a.

Bạn xem tin nhắn tôi gửi bạn chưa?

 

[seikoqn]

Cám ơn anh Hailua
E muốn làm với nhiều sheet thì sao?( tầm 30 sheet) @hailua. thì code thay đổi như nào ạ file test nên e chỉ để 3sheet.
Và nếu xóa 1 sheet thì lại phải sửa code theo. Có cách nào thêm bớt sheet mà code vẫn dùng được ko a.

Xem video xem đã đúng ý bạn chưa?
https://www.youtube.com/watch?v=i64WDnByOHM&feature=youtu.be

 

[SA_DQ]

Thêm 1 tham khảo bằng VBA đơn giản cho bạn

 

[Hai Lúa Miền Tây]

Cám ơn anh Hailua
E muốn làm với nhiều sheet thì sao?( tầm 30 sheet) @hailua. thì code thay đổi như nào ạ file test nên e chỉ để 3sheet.
Và nếu xóa 1 sheet thì lại phải sửa code theo. Có cách nào thêm bớt sheet mà code vẫn dùng được ko a.

Bạn dùng code sau nhé:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, [C2]) Is Nothing Then
       Dim cnn As Object, rst As Object, strSQl As String
       Dim i As Integer
       i = Sheets.Count
       Set cnn = CreateObject("ADODB.Connection")
       cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                "Data Source=" & ThisWorkbook.FullName & ";" & _
                ";Extended Properties=""Excel 8.0;HDR=No;"";"
       For i = 1 To i
           If Worksheets(i).Name <> ActiveSheet.Name Then
               strSQl = strSQl & " SELECT F1,F5,F6 FROM [" & Worksheets(i).Name & "$B9:G100] where F1='" & Target & "' union all "
           End If
       Next
       Set rst = cnn.Execute(Left(strSQl, Len(strSQl) - 10))
       [B6:D100].ClearContents
       [B6].CopyFromRecordset rst
    End If
    
End Sub

 

[djlmah]

Cám ơn mod Hailua làm free cho e.