Lọc nhiều điều kiện bằng VBA

Liên hệ QC
T

thao nguyen01

Thành viên thường trực
Tham gia
8/12/19
Bài viết
214
Được thích
25
Kính gửi anh/chị trên diễn đàn,

Em muốn chọn nhiều trường hợp của cùng điều kiện lọc. File của em viết code có nhiều điều kiện đồng thời nhưng không thể chọn nhiều trường hợp của cùng một điều kiện. Em có mô tả trong file ạ. Em có đọc code trong bài "Lọc dữ liệu-chứa nhiều điều kiện lọc?" nhưng em chưa thể vận dụng lại theo bài và code của em được. Anh/chị xem giúp em ạ.

Em cảm ơn nhiều ạ.
 

File đính kèm

  • bai tap.xlsb
    26 KB · Đọc: 22
Sắp xếp theo thời gian sắp xếp theo bầu chọn
thao nguyen01 đã viết:
Kính gửi anh/chị trên diễn đàn,

Em muốn chọn nhiều trường hợp của cùng điều kiện lọc. File của em viết code có nhiều điều kiện đồng thời nhưng không thể chọn nhiều trường hợp của cùng một điều kiện. Em có mô tả trong file ạ. Em có đọc code trong bài "Lọc dữ liệu-chứa nhiều điều kiện lọc?" nhưng em chưa thể vận dụng lại theo bài và code của em được. Anh/chị xem giúp em ạ.

Em cảm ơn nhiều ạ.
Nhấp chuột vào đây để mở rộng...
Tạo vùng đệm lưu các điều kiện nơi phát hành, code lọc sẽ dựa vào vùng đệm nầy
Code lọc tự lo
Mã: 
Sub Add_VungDem_NoiPhatHanh()
  Dim eRow&, i&,NoiPhatHanh$
  eRow = Range("K" & Rows.Count).End(xlUp).Row
  NoiPhatHanh = Range("C4").Value
  If NoiPhatHanh <> Empty Then
    For i = 2 To eRow
      If NoiPhatHanh = Cells(i, "K") Then Exit For
    Next i
    If i = eRow + 1 Then Range("K" & eRow + 1).Value = NoiPhatHanh
  End If
End Sub

Sub Clear_VungDem()
  Dim eRow&
  eRow = Range("K" & Rows.Count).End(xlUp).Row
  If eRow > 1 Then Range("K2:K" & eRow).ClearContents
End Sub
 

File đính kèm

  • bai tap.xlsb
    26.8 KB · Đọc: 19
Upvote 0
HieuCD đã viết:
Tạo vùng đệm lưu các điều kiện nơi phát hành, code lọc sẽ dựa vào vùng đệm nầy
Code lọc tự lo
Mã: 
Sub Add_VungDem_NoiPhatHanh()
  Dim eRow&, i&,NoiPhatHanh$
  eRow = Range("K" & Rows.Count).End(xlUp).Row
  NoiPhatHanh = Range("C4").Value
  If NoiPhatHanh <> Empty Then
    For i = 2 To eRow
      If NoiPhatHanh = Cells(i, "K") Then Exit For
    Next i
    If i = eRow + 1 Then Range("K" & eRow + 1).Value = NoiPhatHanh
  End If
End Sub

Sub Clear_VungDem()
  Dim eRow&
  eRow = Range("K" & Rows.Count).End(xlUp).Row
  If eRow > 1 Then Range("K2:K" & eRow).ClearContents
End Sub
Nhấp chuột vào đây để mở rộng...

Dạ, em cảm ơn Thầy ạ. Nhưng khi em dùng vùng đệm để lọc thì code của em ở module 1 em không biết chỉnh như thế nào ạ. Em có cho Dic vào để nhớ cột ở vùng đệm. Nhưng kết quả không đúng ạ. Thầy có thể xem giúp em với ạ. . Em cảm ơn Thầy

Sub baocao()
Dim i As Long
Dim k As Long
Dim arr_N()
Dim arr_DS()
Dim arr_D()
Dim dic01 As Object
Dim dcuoi As Long
Dim loai As String
Dim NoiPhatHanh As String
Dim So As String
Dim Flag01 As Boolean
Dim Flag02 As Boolean
Dim Flag03 As Boolean

dcuoi = Sheet1.Range("a1000").End(xlUp).Row
arr_N = Sheet1.Range("A3:I" & dcuoi)
arr_DS = Sheet2.Range("K2:K3")

ReDim arr_D(1 To UBound(arr_N, 1), 1 To 9)
Set dic01 = CreateObject("scripting.dictionary")

k = 0
Tungay = Sheet2.Range("C1")
Denngay = Sheet2.Range("C2")
loai = Sheet2.Range("C3")
NoiPhatHanh = Sheet2.Range("C4")
So = Sheet2.Range("C5")

For j = 1 To UBound(arr_DS, 1)
If Not dic01.exists(arr_DS(j, 1)) Then
dic01.Add arr_DS(j, 1), ""
End If
Next


For i = 1 To UBound(arr_N, 1)

If loai <> "" Then
Flag01 = (loai = arr_N(i, 4))
Else
Flag01 = True
End If

If NoiPhatHanh = "" Then
Flag02 = True
Else
If dic01.exists(arr_N(i, 8)) Then
Flag02 = (NoiPhatHanh = arr_N(i, 8))
End If

End If
If So <> "" Then
Flag03 = (So = arr_N(i, 5))
Else
Flag03 = True
End If


If arr_N(i, 3) >= Tungay And arr_N(i, 3) <= Denngay And Flag01 And Flag02 And Flag03 Then
k = k + 1
arr_D(k, 1) = k
arr_D(k, 2) = arr_N(i, 2)
arr_D(k, 3) = arr_N(i, 3)
arr_D(k, 4) = arr_N(i, 4)
arr_D(k, 5) = arr_N(i, 5)
arr_D(k, 6) = arr_N(i, 6)
arr_D(k, 7) = arr_N(i, 7)
arr_D(k, 8) = arr_N(i, 8)
arr_D(k, 9) = arr_N(i, 9)
End If

Next

Sheet2.Range("A9:I1000").Clear
If k = 0 Then Exit Sub
Sheet2.Range("a9").Resize(k, 9) = arr_D

End Sub
 

File đính kèm

  • bai tap.xlsb
    27.9 KB · Đọc: 6
Upvote 0
thao nguyen01 đã viết:
Dạ, em cảm ơn Thầy ạ. Nhưng khi em dùng vùng đệm để lọc thì code của em ở module 1 em không biết chỉnh như thế nào ạ. Em có cho Dic vào để nhớ cột ở vùng đệm. Nhưng kết quả không đúng ạ. Thầy có thể xem giúp em với ạ. . Em cảm ơn Thầy

Sub baocao()
Dim i As Long
Dim k As Long
Dim arr_N()
Dim arr_DS()
Dim arr_D()
Dim dic01 As Object
Dim dcuoi As Long
Dim loai As String
Dim NoiPhatHanh As String
Dim So As String
Dim Flag01 As Boolean
Dim Flag02 As Boolean
Dim Flag03 As Boolean

dcuoi = Sheet1.Range("a1000").End(xlUp).Row
arr_N = Sheet1.Range("A3:I" & dcuoi)
arr_DS = Sheet2.Range("K2:K3")

ReDim arr_D(1 To UBound(arr_N, 1), 1 To 9)
Set dic01 = CreateObject("scripting.dictionary")

k = 0
Tungay = Sheet2.Range("C1")
Denngay = Sheet2.Range("C2")
loai = Sheet2.Range("C3")
NoiPhatHanh = Sheet2.Range("C4")
So = Sheet2.Range("C5")

For j = 1 To UBound(arr_DS, 1)
If Not dic01.exists(arr_DS(j, 1)) Then
dic01.Add arr_DS(j, 1), ""
End If
Next


For i = 1 To UBound(arr_N, 1)

If loai <> "" Then
Flag01 = (loai = arr_N(i, 4))
Else
Flag01 = True
End If

If NoiPhatHanh = "" Then
Flag02 = True
Else
If dic01.exists(arr_N(i, 8)) Then
Flag02 = (NoiPhatHanh = arr_N(i, 8))
End If

End If
If So <> "" Then
Flag03 = (So = arr_N(i, 5))
Else
Flag03 = True
End If


If arr_N(i, 3) >= Tungay And arr_N(i, 3) <= Denngay And Flag01 And Flag02 And Flag03 Then
k = k + 1
arr_D(k, 1) = k
arr_D(k, 2) = arr_N(i, 2)
arr_D(k, 3) = arr_N(i, 3)
arr_D(k, 4) = arr_N(i, 4)
arr_D(k, 5) = arr_N(i, 5)
arr_D(k, 6) = arr_N(i, 6)
arr_D(k, 7) = arr_N(i, 7)
arr_D(k, 8) = arr_N(i, 8)
arr_D(k, 9) = arr_N(i, 9)
End If

Next

Sheet2.Range("A9:I1000").Clear
If k = 0 Then Exit Sub
Sheet2.Range("a9").Resize(k, 9) = arr_D

End Sub
Nhấp chuột vào đây để mở rộng...
Xem code
Mã: 
Sub baocao()
Dim dcuoi As Long, i As Long, k As Long, j As Long
Dim arr_N(), arr_DS, arr_D(), dic01 As Object
Dim loai As String, NoiPhatHanh As String, So As String

dcuoi = Sheet1.Range("a1000").End(xlUp).Row
arr_N = Sheet1.Range("A3:I" & dcuoi).Value
ReDim arr_D(1 To UBound(arr_N, 1), 1 To 9)

Set dic01 = CreateObject("scripting.dictionary")
dcuoi = Sheet2.Range("K1000").End(xlUp).Row
If dcuoi > 1 Then
  arr_DS = Sheet2.Range("K2:L" & dcuoi).Value
  For j = 1 To UBound(arr_DS, 1)
      dic01.Item(arr_DS(j, 1)) = ""
  Next
End If

Tungay = Sheet2.Range("C1").Value
Denngay = Sheet2.Range("C2").Value
loai = Sheet2.Range("C3").Value
So = Sheet2.Range("C5").Value
NoiPhatHanh = Sheet2.Range("C4")
If NoiPhatHanh <> Empty Then dic01.Item(NoiPhatHanh) = ""

k = 0
For i = 1 To UBound(arr_N, 1)
  If loai = Empty Or loai = arr_N(i, 4) Then
    If dic01.Count = 0 Or dic01.exists(arr_N(i, 8)) Then
      If So = Empty Or So = arr_N(i, 5) Then
        If Tungay = Empty Or arr_N(i, 3) >= Tungay Then
          If Denngay = Empty Or arr_N(i, 3) <= Denngay Then
            k = k + 1
            arr_D(k, 1) = k
            For j = 2 To 9
              arr_D(k, j) = arr_N(i, j)
            Next j
          End If
        End If
      End If
    End If
  End If
Next

Sheet2.Range("A9:I1000").Clear
If k > 0 Then Sheet2.Range("a9").Resize(k, 9) = arr_D
End Sub
 
Upvote 0
thao nguyen01 đã viết:
Kính gửi anh/chị trên diễn đàn,

Em muốn chọn nhiều trường hợp của cùng điều kiện lọc. File của em viết code có nhiều điều kiện đồng thời nhưng không thể chọn nhiều trường hợp của cùng một điều kiện. Em có mô tả trong file ạ. Em có đọc code trong bài "Lọc dữ liệu-chứa nhiều điều kiện lọc?" nhưng em chưa thể vận dụng lại theo bài và code của em được. Anh/chị xem giúp em ạ.

Em cảm ơn nhiều ạ.
Nhấp chuột vào đây để mở rộng...
Bạn thử File, khi C4 thay đổi thì sẽ lọc theo tiêu chí đã chọn.
 

File đính kèm

  • Filter ngày với 2 tiêu chí.xlsb
    20.9 KB · Đọc: 9
Upvote 0
HieuCD đã viết:
Xem code
Mã: 
Sub baocao()
Dim dcuoi As Long, i As Long, k As Long, j As Long
Dim arr_N(), arr_DS, arr_D(), dic01 As Object
Dim loai As String, NoiPhatHanh As String, So As String

dcuoi = Sheet1.Range("a1000").End(xlUp).Row
arr_N = Sheet1.Range("A3:I" & dcuoi).Value
ReDim arr_D(1 To UBound(arr_N, 1), 1 To 9)

Set dic01 = CreateObject("scripting.dictionary")
dcuoi = Sheet2.Range("K1000").End(xlUp).Row
If dcuoi > 1 Then
  arr_DS = Sheet2.Range("K2:L" & dcuoi).Value
  For j = 1 To UBound(arr_DS, 1)
      dic01.Item(arr_DS(j, 1)) = ""
  Next
End If

Tungay = Sheet2.Range("C1").Value
Denngay = Sheet2.Range("C2").Value
loai = Sheet2.Range("C3").Value
So = Sheet2.Range("C5").Value
NoiPhatHanh = Sheet2.Range("C4")
If NoiPhatHanh <> Empty Then dic01.Item(NoiPhatHanh) = ""

k = 0
For i = 1 To UBound(arr_N, 1)
  If loai = Empty Or loai = arr_N(i, 4) Then
    If dic01.Count = 0 Or dic01.exists(arr_N(i, 8)) Then
      If So = Empty Or So = arr_N(i, 5) Then
        If Tungay = Empty Or arr_N(i, 3) >= Tungay Then
          If Denngay = Empty Or arr_N(i, 3) <= Denngay Then
            k = k + 1
            arr_D(k, 1) = k
            For j = 2 To 9
              arr_D(k, j) = arr_N(i, j)
            Next j
          End If
        End If
      End If
    End If
  End If
Next

Sheet2.Range("A9:I1000").Clear
If k > 0 Then Sheet2.Range("a9").Resize(k, 9) = arr_D
End Sub
Nhấp chuột vào đây để mở rộng...

Dạ, em cảm ơn Thầy ạ. Kết quả ra đúng ạ. Nhưng em không hiểu hai dòng code bên dưới.

1) If NoiPhatHanh <> Empty Then dic01.Item(NoiPhatHanh) = ""
Em không hiểu là nếu noiphathanh<> Empty thì sẽ lấy dic01.Item(NoiPhatHanh) = ""? Em hiểu là lấy những giá trị tồn tại trong dic01 đúng không ạ? Nếu em viết là If NoiPhatHanh <> Empty Then NoiPhatHanh = dic01.Item(NoiPhatHanh), có đúng không ạ?

2) If i = eRow + 1 Then Range("K" & eRow + 1).Value = NoiPhatHanh
Em không hiểu tại sao tạo vùng đệm lại có dòng này ạ

Thầy giải thích giúp em. Em cảm ơn Thầy.
Bài đã được tự động gộp:

be09 đã viết:
Bạn thử File, khi C4 thay đổi thì sẽ lọc theo tiêu chí đã chọn.
Nhấp chuột vào đây để mở rộng...

Dạ, con cảm ơn Bác đã xem và giúp con ạ. Nhưng vì khác mục tiêu của con chút là: con muốn chọn đồng thời nhiều tiêu chí như văn phòng, công ty ABC của cùng một điều kiện ạ. Con cảm ơn Bác nhiều.
 
Upvote 0
thao nguyen01 đã viết:
Dạ, em cảm ơn Thầy ạ. Kết quả ra đúng ạ. Nhưng em không hiểu hai dòng code bên dưới.

1) If NoiPhatHanh <> Empty Then dic01.Item(NoiPhatHanh) = ""
Em không hiểu là nếu noiphathanh<> Empty thì sẽ lấy dic01.Item(NoiPhatHanh) = ""? Em hiểu là lấy những giá trị tồn tại trong dic01 đúng không ạ? Nếu em viết là If NoiPhatHanh <> Empty Then NoiPhatHanh = dic01.Item(NoiPhatHanh), có đúng không ạ?

2) If i = eRow + 1 Then Range("K" & eRow + 1).Value = NoiPhatHanh
Em không hiểu tại sao tạo vùng đệm lại có dòng này ạ

Thầy giải thích giúp em. Em cảm ơn Thầy.
Bài đã được tự động gộp:



Dạ, con cảm ơn Bác đã xem và giúp con ạ. Nhưng vì khác mục tiêu của con chút là: con muốn chọn đồng thời nhiều tiêu chí như văn phòng, công ty ABC của cùng một điều kiện ạ. Con cảm ơn Bác nhiều.
Nhấp chuột vào đây để mở rộng...
Sao không thử chọn nhiều điều kiện từ C1: C4 để xem kết quả nó thế nào?
 
Upvote 0
thao nguyen01 đã viết:
Dạ, em cảm ơn Thầy ạ. Kết quả ra đúng ạ. Nhưng em không hiểu hai dòng code bên dưới.

1) If NoiPhatHanh <> Empty Then dic01.Item(NoiPhatHanh) = ""
Em không hiểu là nếu noiphathanh<> Empty thì sẽ lấy dic01.Item(NoiPhatHanh) = ""? Em hiểu là lấy những giá trị tồn tại trong dic01 đúng không ạ? Nếu em viết là If NoiPhatHanh <> Empty Then NoiPhatHanh = dic01.Item(NoiPhatHanh), có đúng không ạ?

2) If i = eRow + 1 Then Range("K" & eRow + 1).Value = NoiPhatHanh
Em không hiểu tại sao tạo vùng đệm lại có dòng này ạ

Thầy giải thích giúp em. Em cảm ơn Thầy.
Bài đã được tự động gộp:



Dạ, con cảm ơn Bác đã xem và giúp con ạ. Nhưng vì khác mục tiêu của con chút là: con muốn chọn đồng thời nhiều tiêu chí như văn phòng, công ty ABC của cùng một điều kiện ạ. Con cảm ơn Bác nhiều.
Nhấp chuột vào đây để mở rộng...
1) If NoiPhatHanh <> Empty Then dic01.Item(NoiPhatHanh) = "" là thêm key NoiPhatHanh vào Dic01 tương dương với lệnh Add nhưng không cần kiểm tra chưa tồn tại (.Exists)
If NoiPhatHanh <> Empty Then NoiPhatHanh = dic01.Item(NoiPhatHanh), Không thay thế được lệnh trên

2)
For i = 2 To eRow
If NoiPhatHanh = Cells(i, "K") Then Exit For
Next i
If i = eRow + 1 Then Range("K" & eRow + 1).Value = NoiPhatHanh

If NoiPhatHanh = Cells(i, "K") Then Exit For' Nếu cột k đã có NoiPhatHanh thì không ghi tiếp, lệnh Exit for thoát khỏi vòng lập nên i <= erow
Nếu cột K chưa có NoiPhatHanh vòng For sẽ chạy đến cuối cùng và ra khỏi vòng for lúc đó i=eRow+1 và ghi NoiPhatHanh vào dòng cuối +1 cột K
If i = eRow + 1 Then Range("K" & eRow + 1).Value = NoiPhatHanh

Bạn bấm hím chức năng F8 để xem vận hành của từng dòng lệnh
 
Upvote 0
HieuCD đã viết:
1) If NoiPhatHanh <> Empty Then dic01.Item(NoiPhatHanh) = "" là thêm key NoiPhatHanh vào Dic01 tương dương với lệnh Add nhưng không cần kiểm tra chưa tồn tại (.Exists)
If NoiPhatHanh <> Empty Then NoiPhatHanh = dic01.Item(NoiPhatHanh), Không thay thế được lệnh trên

2)
For i = 2 To eRow
If NoiPhatHanh = Cells(i, "K") Then Exit For
Next i
If i = eRow + 1 Then Range("K" & eRow + 1).Value = NoiPhatHanh

If NoiPhatHanh = Cells(i, "K") Then Exit For' Nếu cột k đã có NoiPhatHanh thì không ghi tiếp, lệnh Exit for thoát khỏi vòng lập nên i <= erow
Nếu cột K chưa có NoiPhatHanh vòng For sẽ chạy đến cuối cùng và ra khỏi vòng for lúc đó i=eRow+1 và ghi NoiPhatHanh vào dòng cuối +1 cột K
If i = eRow + 1 Then Range("K" & eRow + 1).Value = NoiPhatHanh

Bạn bấm hím chức năng F8 để xem vận hành của từng dòng lệnh
Nhấp chuột vào đây để mở rộng...
Dạ, Thầy cho em hỏi dòng này ạ:
If NoiPhatHanh <> Empty Then dic01.Item(NoiPhatHanh) = "" là thêm key NoiPhatHanh vào Dic01 tương dương với lệnh Add nhưng không cần kiểm tra chưa tồn tại (.Exists)

Em viết lại như sau thì báo lỗi ạ. Vì em quen viết dic.add ạ
If NoiPhatHanh <> Empty Then dic01.Add ((NoiPhatHanh)), ""

Thầy sửa giúp em ạ. Em cảm ơn Thầy.
Bài đã được tự động gộp:

be09 đã viết:
Sao không thử chọn nhiều điều kiện từ C1: C4 để xem kết quả nó thế nào?
Nhấp chuột vào đây để mở rộng...
Dạ, con chọn từ C1:C4 nhưng con chỉ chọn được 1 tiêu chí cho một lần chọn ạ.
 
Lần chỉnh sửa cuối:
Upvote 0
thao nguyen01 đã viết:
Dạ, Thầy cho em hỏi dòng này ạ:
If NoiPhatHanh <> Empty Then dic01.Item(NoiPhatHanh) = "" là thêm key NoiPhatHanh vào Dic01 tương dương với lệnh Add nhưng không cần kiểm tra chưa tồn tại (.Exists)

Em viết lại như sau thì báo lỗi ạ. Vì em quen viết dic.add ạ
If NoiPhatHanh <> Empty Then dic01.Add ((NoiPhatHanh)), ""

Thầy sửa giúp em ạ. Em cảm ơn Thầy.
Bài đã được tự động gộp:


Dạ, con chọn từ C1:C4 nhưng con chỉ chọn được 1 tiêu chí cho một lần chọn ạ.
Nhấp chuột vào đây để mở rộng...
Phải thêm lệnh dic01.exists

If NoiPhatHanh <> Empty Then
If dic01.exists(NoiPhatHanh) = False Then dic01.Add ((NoiPhatHanh)), ""
End If
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

Bich2B
lỗi định dạng ngày không đọc được công thức excel
Trả lời
9
Đọc
200
thaiduylamus
thaiduylamus
C
Giúp em viết công thức làm lịch thi đấu.
Trả lời
0
Đọc
11
caocat
C
D
Tính khoảng cách giữa 2 tọa độ?
Trả lời
4
Đọc
61
danhculao
D
pupuchcha
  • Question
Viết code để tìm xích ma, mong mọi người giúp đỡ em ạ
Trả lời
0
Đọc
23
pupuchcha
pupuchcha
K
Nhờ mọi người hỗ trợ giúp mình về tìm kiếm trong VBA. Mình sẽ gửi chút chi phí cafe cám ơn nhiều ạ
    • Cười
Trả lời
18
Đọc
302
VetMini
V
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom