Trích xuất dữ liệu sang sheet khác theo các điều kiện lọc khác nhau (sử dụng vba) (1 người xem)

[taiktqd]

Kính gửi các anh chị GPE,
Em biết là chủ đề này đã có người lập rất nhiều. Nhưng do hiện tại em chưa có một chút kiến thức nào về VBA. Nên em lập thread nhờ Anh chị hỗ trợ tạo code lọc dữ liệu giúp Em.
Đề bài: Em có một file tài liệu tổng hợp dữ liệu sản xuất của Công ty (file đính kèm - Sheet Detail Data). Em muốn bên sheet processdata khi nhập các điều kiện lọc khác nhau, thì dữ liệu sẽ hiện xuống bên dưới, mục đích của em là phân tích dữ liệu sau khi lọc được sang sheet chart.
Em xin cảm ơn.

 

[CHAOQUAY]

Kính gửi các anh chị GPE,
Em biết là chủ đề này đã có người lập rất nhiều. Nhưng do hiện tại em chưa có một chút kiến thức nào về VBA. Nên em lập thread nhờ Anh chị hỗ trợ tạo code lọc dữ liệu giúp Em.
Đề bài: Em có một file tài liệu tổng hợp dữ liệu sản xuất của Công ty (file đính kèm - Sheet Detail Data). Em muốn bên sheet processdata khi nhập các điều kiện lọc khác nhau, thì dữ liệu sẽ hiện xuống bên dưới, mục đích của em là phân tích dữ liệu sau khi lọc được sang sheet chart.
Em xin cảm ơn.

Bạn làm thử 1 ví dụ cụ thể lên xem sao

 

[taiktqd]

Bạn làm thử 1 ví dụ cụ thể lên xem sao

Đây là em lọc thủ công: theo các điều kiện chọn bên trên (màu vàng), rồi copy từ dữ liệu nguồn sang bảng dữ liệu đích bên sheet processdata. Cái em muốn là em chỉ cần chọn các điều kiện, rồi bấm nút thực hiện là nó sẽ hiện ra luôn ấy ạ.

 

[taiktqd]

Muốn code thì chỉ cần Record Macro thao tác lọc thủ công

Em chưa hiểu phần này lắm. Anh có thể làm ví dụ để em hiểu record macro có thể tiếp tục cập nhật khi dữ liệu lọc thay đổi không ạ?

 

[Ba Rọi 33]

Em chưa hiểu phần này lắm. Anh có thể làm ví dụ để em hiểu record macro có thể tiếp tục cập nhật khi dữ liệu lọc thay đổi không ạ?

Bạn thử Code này xem sao

Sub Filters_Data()
    Dim sArr, dArr, I As Long, J As Long, K As Long, Idx As Long
    Dim aTmp, Tmp, ArrColums(), DkFilters As String, n As Long
    Dim fDate As Long, eDate As Long, DK As String
With Sheets("ProcessData")
    fDate = .Range("H3").Value: eDate = .Range("I3").Value
    aTmp = Array(.Range("C3").Value, .Range("D3").Value, .Range("E3").Value, .Range("F3").Value, .Range("G3").Value)
    Tmp = Array(1, 2, 4, 5, 6)
    For I = LBound(aTmp) To UBound(aTmp)
        If aTmp(I) <> Empty Then
            DkFilters = IIf(DkFilters = "", aTmp(I), DkFilters & "#" & aTmp(I))
            n = n + 1
            ReDim Preserve ArrColums(1 To n)
            ArrColums(n) = Tmp(I)
        End If
    Next I
End With
With Sheets("Detail Data")
    sArr = .Range("B4", .Range("B" & Rows.Count).End(xlUp)).Resize(, 18).Value
    ReDim dArr(1 To UBound(sArr), 1 To UBound(sArr, 2) + 1)
    For I = 1 To UBound(sArr)
        DK = ""
        If CLng(sArr(I, 3)) >= fDate Then
            If CLng(sArr(I, 3)) <= eDate Then
                For Idx = LBound(ArrColums) To UBound(ArrColums)
                    DK = IIf(DK = "", sArr(I, ArrColums(Idx)), DK & "#" & sArr(I, ArrColums(Idx)))
                Next Idx
                If DK = DkFilters Then
                    K = K + 1
                    dArr(K, 1) = K
                    For J = 1 To UBound(sArr, 2)
                        dArr(K, J + 1) = sArr(I, J)
                    Next J
                End If
            End If
        End If
    Next I
End With
With Sheets("ProcessData")
    If K Then
        .Range("A7").Resize(5000, UBound(dArr, 2)).ClearContents
        .Range("A7").Resize(K, UBound(dArr, 2)) = dArr
    End If
End With
End Sub

 

[taiktqd]

Bạn thử Code này xem sao

Sub Filters_Data()
    Dim sArr, dArr, I As Long, J As Long, K As Long, Idx As Long
    Dim aTmp, Tmp, ArrColums(), DkFilters As String, n As Long
    Dim fDate As Long, eDate As Long, DK As String
With Sheets("ProcessData")
    fDate = .Range("H3").Value: eDate = .Range("I3").Value
    aTmp = Array(.Range("C3").Value, .Range("D3").Value, .Range("E3").Value, .Range("F3").Value, .Range("G3").Value)
    Tmp = Array(1, 2, 4, 5, 6)
    For I = LBound(aTmp) To UBound(aTmp)
        If aTmp(I) <> Empty Then
            DkFilters = IIf(DkFilters = "", aTmp(I), DkFilters & "#" & aTmp(I))
            n = n + 1
            ReDim Preserve ArrColums(1 To n)
            ArrColums(n) = Tmp(I)
        End If
    Next I
End With
With Sheets("Detail Data")
    sArr = .Range("B4", .Range("B" & Rows.Count).End(xlUp)).Resize(, 18).Value
    ReDim dArr(1 To UBound(sArr), 1 To UBound(sArr, 2) + 1)
    For I = 1 To UBound(sArr)
        DK = ""
        If CLng(sArr(I, 3)) >= fDate Then
            If CLng(sArr(I, 3)) <= eDate Then
                For Idx = LBound(ArrColums) To UBound(ArrColums)
                    DK = IIf(DK = "", sArr(I, ArrColums(Idx)), DK & "#" & sArr(I, ArrColums(Idx)))
                Next Idx
                If DK = DkFilters Then
                    K = K + 1
                    dArr(K, 1) = K
                    For J = 1 To UBound(sArr, 2)
                        dArr(K, J + 1) = sArr(I, J)
                    Next J
                End If
            End If
        End If
    Next I
End With
With Sheets("ProcessData")
    If K Then
        .Range("A7").Resize(5000, UBound(dArr, 2)).ClearContents
        .Range("A7").Resize(K, UBound(dArr, 2)) = dArr
    End If
End With
End Sub

Cảm ơn Anh rất nhiều. Em chạy ok luôn rồi ạ.

 

[taiktqd]

Bạn thử Code này xem sao

Sub Filters_Data()
    Dim sArr, dArr, I As Long, J As Long, K As Long, Idx As Long
    Dim aTmp, Tmp, ArrColums(), DkFilters As String, n As Long
    Dim fDate As Long, eDate As Long, DK As String
With Sheets("ProcessData")
    fDate = .Range("H3").Value: eDate = .Range("I3").Value
    aTmp = Array(.Range("C3").Value, .Range("D3").Value, .Range("E3").Value, .Range("F3").Value, .Range("G3").Value)
    Tmp = Array(1, 2, 4, 5, 6)
    For I = LBound(aTmp) To UBound(aTmp)
        If aTmp(I) <> Empty Then
            DkFilters = IIf(DkFilters = "", aTmp(I), DkFilters & "#" & aTmp(I))
            n = n + 1
            ReDim Preserve ArrColums(1 To n)
            ArrColums(n) = Tmp(I)
        End If
    Next I
End With
With Sheets("Detail Data")
    sArr = .Range("B4", .Range("B" & Rows.Count).End(xlUp)).Resize(, 18).Value
    ReDim dArr(1 To UBound(sArr), 1 To UBound(sArr, 2) + 1)
    For I = 1 To UBound(sArr)
        DK = ""
        If CLng(sArr(I, 3)) >= fDate Then
            If CLng(sArr(I, 3)) <= eDate Then
                For Idx = LBound(ArrColums) To UBound(ArrColums)
                    DK = IIf(DK = "", sArr(I, ArrColums(Idx)), DK & "#" & sArr(I, ArrColums(Idx)))
                Next Idx
                If DK = DkFilters Then
                    K = K + 1
                    dArr(K, 1) = K
                    For J = 1 To UBound(sArr, 2)
                        dArr(K, J + 1) = sArr(I, J)
                    Next J
                End If
            End If
        End If
    Next I
End With
With Sheets("ProcessData")
    If K Then
        .Range("A7").Resize(5000, UBound(dArr, 2)).ClearContents
        .Range("A7").Resize(K, UBound(dArr, 2)) = dArr
    End If
End With
End Sub

Bác baroi xem lại giúp em với ạ. Có thể bảng điều kiện em đưa ra làm bác hiểu nhầm. Hiện tại code đang có vấn đề là: bắt buộc phải chọn một trong các trường dữ liệu: công đoạn, ca, số lệnh, model và đồng thời phải chọn khoảng thời gian thì mới lọc được. Em muốn, các trường này đứng độc lập ấy ạ. Tức là:
1. nếu không nhập thông tin gì vào các điều kiện lọc (coi như không có điều kiện), thì click macro sẽ hiện là toàn bộ bảng dữ liệu nguồn.
2. Nếu điền một trong số các trường thông tin, nó sẽ lọc theo điều kiện đó, không bắt buộc các trường kia phải phụ thuộc vào khoảng thời gian và ngược lại: trường khoảng thời gian cũng độc lập hoàn toàn với các trường kia ấy ạ.
Em xin cảm ơn ạ.

 

[taiktqd]

Ý 1 em viết bên trên thì có thể tự xử lý được. Nhưng ý 2 thì là tác vụ chính của việc lọc dữ liệu để phân tích. Mà em chủ yếu lọc theo điều kiện trong khoảng thời gian thôi ấy ạ.

 

[Ba Rọi 33]

Bác baroi xem lại giúp em với ạ. Có thể bảng điều kiện em đưa ra làm bác hiểu nhầm. Hiện tại code đang có vấn đề là: bắt buộc phải chọn một trong các trường dữ liệu: công đoạn, ca, số lệnh, model và đồng thời phải chọn khoảng thời gian thì mới lọc được. Em muốn, các trường này đứng độc lập ấy ạ. Tức là:
1. nếu không nhập thông tin gì vào các điều kiện lọc (coi như không có điều kiện), thì click macro sẽ hiện là toàn bộ bảng dữ liệu nguồn.
2. Nếu điền một trong số các trường thông tin, nó sẽ lọc theo điều kiện đó, không bắt buộc các trường kia phải phụ thuộc vào khoảng thời gian và ngược lại: trường khoảng thời gian cũng độc lập hoàn toàn với các trường kia ấy ạ.
Em xin cảm ơn ạ.

Bạn xem thử

 

[taiktqd]

Bạn xem thử

Thanks Bác, hôm qua em test thử lại. Hôm nay mới có thời gian cảm ơn bác được. Giờ chạy ok hết rồi. Phải đầu tư thời gian học bài bản vba. Bác hỗ trợ nhưng không hiểu gì cả. Có một vấn đề này em thấy phát sinh từ nhu cầu thực tế: người dùng sẽ muốn lọc nhiều tham số của cùng một điều kiện lọc: ví dụ: Khoảng thời gian: muốn lọc 2 khoảng thời gian khác nhau: từ 01/10-03/10 và từ 07/10-13/10; lệnh: muốn lọc ra nhiều lệnh sản xuất cùng lúc. Thì phải chỉnh sửa bổ sung thêm code phần nào à?

Bài đã được tự động gộp: 16/10/18

1. Cho code sau vào Module
2. Cho code sau vào sheet7 (ProcessData)
Ghi chú: Code trên chỉ tìm tương đối giữa các cột điều kiện, nếu 1 cột điều kiện có ký tự mà các cột lại cũng có ký tự tương tự thì dữ liệu cũng được chạy ra.

Thanks bác. Code bác tạo lập em chạy ok luôn rồi ạ.