Lọc dữ liệu theo nhiều điều kiện bằng mảng arr ?

[moihocvba]

Xin chào anh chị!

Bài em sắp hỏi tới đây có thể dùng macro Advance Filter cũng được , nhưng nếu dữ liệu nhiều thì code sẽ chậm và file sẽ nặng nên em xin phép hỏi anh chị cách dùng mảng để cho nhẹ ạ!

Em có bảng nhập liệu A như hình:




Sau đó em có 1 sheet để lọc ra các kết quả theo điều kiện:



Vùng điều kiện ở đây em ví dụ kết hợp 4 điều kiện, thực tế có thể hơn.

Từ ô B3 đến ô E3 ô nào không có có nghĩa là không lọc điều kiện đó (ví dụ trên là em chỉ lọc 2 điều kiện).
Nếu có cả 4 điều kiện thì dùng mảng em viết được. Nhưng nếu khuyết 1 hoặc 2 hoặc 3, 4 trong các điều kiện trên thì mình viết code sao ạ?

Đây là ví dụ, trong thực tế em làm có thể tới 7 8 điều kiện cùng lúc. Mong anh chị GPE giúp em! Cảm ơn anh chị nhiều!

 

[Maika8008]

Tôi thử dùng thì code này chưa xét trường hợp Arrcrit() có 1 hoặc nhiều phần tử có giá trị rỗng
Nhắc bạn: nick đúng của tác giả code là @siwtom chứ không phải Switom

Sub LocDuLieu2()
    Dim arr(), kq(), i As Long, a As Long, lr As Long, j As Long
    lr = Sheet1.Range("A65000").End(xlUp).Row
    arr = Sheet1.Range("A4:H" & lr).Value
    ReDim kq(1 To UBound(arr), 1 To 8)
    For i = 1 To UBound(arr)
        If _
        IIf(Len(Range("B3")) > 0, arr(i, 1) = Range("B3").Value, True) And _
        IIf(Len([C3]) > 0, arr(i, 2) = Range("C3").Value, True) And _
        IIf(Len([D3]) > 0, arr(i, 3) = Range("D3").Value, True) And _
        IIf(Len([E3]) > 0, arr(i, 4) = Range("E3").Value, True) Then
            a = a + 1
            For j = 1 To 8
                kq(a, j) = arr(i, j)
            Next j
        End If
    Next i

Range("A7:H65000").ClearContents
On Error Resume Next ' tranh loi khi khong co ket qua'
Range("A7").Resize(a, 8).Value = kq
End Sub

Điều kiện là vùng điều kiện theo đúng thứ tự cột giống dữ liệu (như file gốc của tác giả). Nếu khác thứ tự thì xử tiếp bằng 1 mảng con khác

Code này đâu có lọc được điều kiện kèm toán tử > , < , ≥ , ≤ ... như Filter Advanced làm phải không bạn?

 

[ndu96081631]

Code này đâu có lọc được điều kiện kèm toán tử > , < , ≥ , ≤ ... như Filter Advanced làm phải không bạn?

Chính xác thì Advanced Filter là trùm, chẳng code nào chống lại được nó cả

 

[Quang_Hải]

Code này đâu có lọc được điều kiện kèm toán tử > , < , ≥ , ≤ ... như Filter Advanced làm phải không bạn?

Bạn tham khảo kiểu code của mình cho vui. Lưu ý là dữ liệu bố trí theo hình đính kèm. Dòng dữ liệu điều kiện lọc ở dòng 2

Sub Loc_Du_Lieu() 'Written by QuangHai
Dim i As Long, j As Long, k As Long
Dim sArr(), dArr(),  dk1 As String, dk2 As String, dk3 As String, dk4 As String
With Sheets("Data")
   sArr = .Range("A4", .Range("A" & Rows.Count).End(3)).Resize(, 8).Value
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To UBound(sArr, 2))
Sheets("loc").[A5].Resize(UBound(sArr), UBound(sArr, 2)).ClearContents
With Sheets("loc")
   dk1 = UCase(.Cells(2, 1))
   dk2 = UCase(.Cells(2, 2))
   dk3 = UCase(.Cells(2, 3))
   dk4 = UCase(.Cells(2, 4))
End With
If Len(dk1 & dk2 & dk3 & dk4) = 0 Then Exit Sub
For i = 1 To UBound(sArr)
   If UCase(sArr(i, 1)) Like "*" & dk1 & "*" Then
      If UCase(sArr(i, 2)) Like "*" & dk2 & "*" Then
         If UCase(sArr(i, 3)) Like "*" & dk3 & "*" Then
            If UCase(sArr(i, 4)) Like "*" & dk4 & "*" Then
               k = k + 1
               For j = 1 To UBound(sArr, 2)
                  dArr(k, j) = sArr(i, j)
               Next
            End If
         End If
      End If
   End If
Next
If k Then Sheets("loc").[A5].Resize(k, UBound(dArr, 2)) = dArr
End Sub
'**********************************************
'Cách khác
Sub FreeFilter() 'Written by QuangHai
Dim i As Long, j As Long, k As Long, Cols As Long
Dim Dk(), sArr(), dArr(), tmp As String, chk As Boolean
Cols = 8
With Sheets("Data")
   sArr = .Range("A4", .Range("A" & Rows.Count).End(3)).Resize(, Cols).Value
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To UBound(sArr, 2))
ReDim Dk(1 To Cols)
With Sheets("loc")
   For j = 1 To UBound(Dk)
      Dk(j) = UCase(Trim(.Cells(2, j).Value))
   Next
   .[A5].Resize(UBound(sArr), Cols).ClearContents
End With
If Join(Dk, "") = Empty Then GoTo Thoat
For i = 1 To UBound(sArr, 1)
   For j = 1 To Cols
      tmp = "*" & UCase(Dk(j)) & "*"
      If UCase(sArr(i, j)) Like tmp Then
         chk = True
      Else
         chk = False
         Exit For
      End If
   Next
   If chk = True Then
      k = k + 1
      For j = 1 To Cols
         dArr(k, j) = sArr(i, j)
      Next
   End If
Next

If k Then
   Sheets("loc").[A5].Resize(k, UBound(dArr, 2)) = dArr
Else
Thoat:
   MsgBox "No Data Found"
End If

End Sub

 

[ptm0412]

Em thấy Power Bi vẫn tạo được báo cáo in được anh! Chỉ là không phải bản thương mại thì chỉ xuất ra PDF được thôi, người nhận chỉ xem được nội dung chứ không chỉnh sửa được!

"Báo cáo in theo mẫu quy định riêng của doanh nghiệp" là báo cáo có logo, có tên công ty địa chỉ, có tiêu đề báo cáo, có "Cộng hoà xã hội ...", tiêu đề cột thì merge tô màu các kiểu, v.v... Dưới báo cáo còn có ngày tháng năm, ba bốn chữ ký và họ tên người ký

Code này đâu có lọc được điều kiện kèm toán tử > , < , ≥ , ≤ ... như Filter Advanced làm phải không bạn?

Đúng vậy. Code này chỉ đáp ứng cho chủ đề này, gọi là có mở rộng ra nhiều điều kiện

 

[tranhungdao12a3]

"Báo cáo in theo mẫu quy định riêng của doanh nghiệp" là báo cáo có logo, có tên công ty địa chỉ, có tiêu đề báo cáo, có "Cộng hoà xã hội ...", tiêu đề cột thì merge tô màu các kiểu, v.v...


Đúng vậy. Code này chỉ đáp ứng cho chủ đề này, gọi là có mở rộng ra nhiều điều kiện

Báo cáo kiểu này thì chả có phần mềm nào theo được. Trong một tương lai gần thì những báo cáo kiểu tốn nhiều thời gian dạng này chắc cũng dần bị thay thế thôi! Những báo cáo kiểu này phù hợp với doanh nghiệp nhà nước hoặc doanh nghiệp có mô hình hoạt động tương tự như thế! Em từng có vài năm mài mông bên EVN và Bộ Công Thương nên cũng hiểu sơ sơ. Lúc đầu tiên em lại hiểu về báo cáo phân tích và quản trị nên bị hố hàng.

 

[ptm0412]

Mở rộng code cho các điều kiện không theo thứ tự cột của dữ liệu, (điều kiện là những cột bất kỳ và không theo thứ tự)
Thêm 1 dòng dưới vùng điều kiện, là thứ tự cột dữ liệu tương ứng của các điều kiện như hình sau:



Code chỉ sửa 2 chỗ: mở rộng mảng DKien thành 2 dòng và dòng code so sánh

Sub LocDuLieu4()
    Dim arr(), kq(), i As Long, a As Long, lr As Long, j As Long
    Dim DkTong As Boolean, Dkien()
    lr = Sheet1.Range("A65000").End(xlUp).Row
    arr = Sheet1.Range("A4:H" & lr).Value
    Dkien = Sheet2.Range("B3:E4").Value
    ReDim kq(1 To UBound(arr), 1 To 8)
   
    For i = 1 To UBound(arr)
        DkTong = True
        For k = 1 To UBound(Dkien, 2)
            If Len(Dkien(1, k)) > 0 Then DkTong = DkTong And (arr(i, Dkien(2, k)) = Dkien(1, k))
            If DkTong = False Then Exit For
        Next
        If DkTong = True Then
            a = a + 1
            For j = 1 To 8
                kq(a, j) = arr(i, j)
            Next j
        End If
    Next i
   
Range("A7:H65000").ClearContents
On Error Resume Next ' tranh loi khi khong co ket qua'
Range("A7").Resize(a, 8).Value = kq
End Sub

 

[HieuCD]

bạn nói Power BI hay Power query? Power BI chỉ để xem dạng báo cáo quản trị, không tạo ra báo cáo in theo mẫu được. Đa số các doanh nghiệp hiện tại vẫn còn xem báo cáo in, hoặc báo cáo gởi qua mail theo mẫu quy định riêng từng doanh nghiệp

So với code LocDulieu3() bài #12 thì bỏ qua thứ tự cột của vùng điều kiện, nhưng hơi phức tạp (nhiều vòng lặp). Như đã nói trong bài #12, tôi chỉ thêm mảng hoặc nới rộng mảng chứ không thêm vòng lặp

Các vòng lập đầu code loại các các cột điều kiện không cần xét, vào vòng lập chính số lần xét điều kiện từng dòng dữ liệu đã giảm tối thiếu, tốc độ xử lý có thể nhanh hơn

 

[ptm0412]

Các vòng lập đầu code loại các các cột điều kiện không cần xét, vào vòng lập chính số lần xét điều kiện từng dòng dữ liệu đã giảm tối thiếu, tốc độ xử lý có thể nhanh hơn

Code của tôi, trong vòng lặp tìm giá trị cho DkTong, nếu gặp điều kiện không thoả đầu tiên là exit vòng lặp, vừa giảm số lần xét vừa bỏ qua điều kiện không thoả của dữ liệu. Tuy nhiên tôi không có ý so sánh 2 cái giảm thiểu của bạn và của tôi, chỉ là bàn thêm về thuật toán

 

[hhoang_56]

Với code Sub LocDuLieu3() ở bài #12
Khi nhập điều kiện tìm kiếm thì phải nhập chính xác chữ hoa, chữ thường thì code mới cho ra kết quả. Vậy cho hỏi có cách nào để nhập thoải mái (không phân biệt chữ hoa chữ thường) mà vẫn lọc cho ra kết quả

 

[ptm0412]

Với code Sub LocDuLieu3() ở bài #12
Khi nhập điều kiện tìm kiếm thì phải nhập chính xác chữ hoa, chữ thường thì code mới cho ra kết quả. Vậy cho hỏi có cách nào để nhập thoải mái (không phân biệt chữ hoa chữ thường) mà vẫn lọc cho ra kết quả

Trong tất cả các trường hợp lọc Advanced filter, sử dụng hàm D (Dmax, DSum, ...), code điều khiển bằng giá trị ô, NÊN CHÍNH XÁC, tốt nhất là dùng Validation hoặc copy paste cho chính xác. Nhập thoải mái có những hậu quả không lường trước: dư khoảng trắng, dữ liệu gốc có vài dữ liệu gần giống nhau