Lọc dử liệu từ nhiều sheet

[laydaihiep]

Mình muốn lọc dử liệu từ sheet 1 và sheet 2 vào sheet TH
Ở file tổng hợp tại ô B8 mình chọn ngày cần xuất.
Giờ mình cần các bạn giúp viết đoạn code lọc dử liệu từ sheet 1 và sheet 2 vào sheet TH (A10;C19)
Đính kèm file
Thank bạn!

 

[laydaihiep]

Có ai giúp mình với ko nhỉ?

 

[truongvu317]

Dữ liệu của bạn có nhiều không, có nhiều sheet không, nếu mà ít thì gộp vào một sheet rồi dùng công thức. Ngược lại mà lớn thì nên sài vba.

 

[laydaihiep]

Thank bạn đã quan tâm!
file excel trên mình chỉ lấy ví dụ, chứ dử liệu của mình rất nhiều bạn.

 

[phulien1902]

Mình muốn lọc dử liệu từ sheet 1 và sheet 2 vào sheet TH
Ở file tổng hợp tại ô B8 mình chọn ngày cần xuất.
Giờ mình cần các bạn giúp viết đoạn code lọc dử liệu từ sheet 1 và sheet 2 vào sheet TH (A10;C19)
Đính kèm file
Thank bạn!

1 cách để bạn tham khảo.

Option Explicit
Sub Capnhat()
Call Test1
Call Test2
End Sub
Sub Test1()
    Dim ws As Worksheet, Sh As Worksheet
    Set Sh = Sheets("GOP")
    Application.ScreenUpdating = False
    Sheets("GOP").Range("A2:D1000").ClearContents
    For Each ws In Worksheets
        If ws.Name = "1" Or ws.Name = "2" Then
            ws.UsedRange.Offset(1).Copy _
                    Sh.Range("A" & Rows.Count).End(3)(2)
        End If
    Next ws
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub
Sub Test2()
    Dim a(), b(1 To 100, 1 To 3), i As Long, j As Long, k As Long, DK As Long
    With Sheets("GOP")
        a = .Range("B2", .Range("D10000").End(xlUp)).Value
    End With
    DK = Sheets("TH").Range("B8").Value
    With Sheets("GOP")
        For i = 1 To UBound(a)
            If a(i, 3) <> Empty And a(i, 3) = DK Then
                k = k + 1
                b(k, 1) = k
                b(k, 2) = a(i, 1)
                b(k, 3) = a(i, 3)
            End If
        Next i
    End With
    With Sheets("TH")
        .Range("A10:C1000").ClearContents
        .Range("A10").Resize(k, 3) = b
    End With
End Sub

 

[nguyenthuy13388]

Mình muốn lọc dử liệu từ sheet 1 và sheet 2 vào sheet TH
Ở file tổng hợp tại ô B8 mình chọn ngày cần xuất.
Giờ mình cần các bạn giúp viết đoạn code lọc dử liệu từ sheet 1 và sheet 2 vào sheet TH (A10;C19)
Đính kèm file
Thank bạn!

Bạn xem file đã đúng ý chưa?

Sub TH()
Dim Sh As Worksheet
Dim sArr(), i As Long, dArr(1 To 3, 1 To 50000), k As Long, Lr As Long

For Each Sh In Worksheets
    If Sh.Name <> "TH" Then
        With Sh
            sArr = .Range("B2:D" & .Range("B50000").End(xlUp).Row).Value
            For i = 1 To UBound(sArr)
                If sArr(i, 3) = Sheets("TH").Range("B8").Value Then
                    k = k + 1
                    dArr(k, 1) = k
                    dArr(k, 2) = sArr(i, 1)
                    dArr(k, 3) = sArr(i, 3)
                End If
            Next i
        End With
    End If
Next Sh
If k > 0 Then
    With Sheets("TH")
        Lr = .Range("A50000").End(xlUp).Row
        If Lr > 9 Then
            .Range("A10:C" & Lr).ClearContents
        End If
        .Range("A10").Resize(k, 3) = dArr
    End With
Else
    MsgBox "không có giá tri thoa man dieu kien"
End If
End Sub

 

[laydaihiep]

Bạn xem file đã đúng ý chưa?

Sub TH()
Dim Sh As Worksheet
Dim sArr(), i As Long, dArr(1 To 3, 1 To 50000), k As Long, Lr As Long

For Each Sh In Worksheets
    If Sh.Name <> "TH" Then
        With Sh
            sArr = .Range("B2:D" & .Range("B50000").End(xlUp).Row).Value
            For i = 1 To UBound(sArr)
                If sArr(i, 3) = Sheets("TH").Range("B8").Value Then
                    k = k + 1
                    dArr(k, 1) = k
                    dArr(k, 2) = sArr(i, 1)
                    dArr(k, 3) = sArr(i, 3)
                End If
            Next i
        End With
    End If
Next Sh
If k > 0 Then
    With Sheets("TH")
        Lr = .Range("A50000").End(xlUp).Row
        If Lr > 9 Then
            .Range("A10:C" & Lr).ClearContents
        End If
        .Range("A10").Resize(k, 3) = dArr
    End With
Else
    MsgBox "không có giá tri thoa man dieu kien"
End If
End Sub

Đây đúng là cái mình cần, thank bạn nhiều!

 

[khoa186]

xin duoc note