Nhờ mọi người giúp code lọc dạng mãng theo nhiều điều kiện

[hunglam123]

Em có 1 file e muốn lọc theo nhiều điều kiện, Nhưng hiện tai em chỉ biết lọc theo 1 điều kiện. Nhờ mọi người giúp đỡ. Xin chân thành cảm ơn ạ !

Code của em hiện tại chỉ lọc được 1 điều kiện tại ô C3 ( Em muốn nó làm được nhiều điều kiện trong vùng C3:C10

Sub loctim1tux()
Dim sArr(), dArr(), I As Long, K As Long, R As Long, Col As Long, Tmp As String
sArr = Range("a3:a10000").Value
R = UBound(sArr)
ReDim dArr(1 To R, 1 To 1) '
For I = 1 To R
            Tmp = Range("c" & I + 2).Value
           If InStr(UCase(Tmp), UCase(Range("c3").Value)) Then
                        K = K + 1
                        For Col = 1 To 1
                            dArr(K, Col) = sArr(I, Col)
                        Next Col
            End If
Next I

On Error Resume Next
Range("E3:E27").ClearContents
Range("E3").Resize(K, 1) = dArr '
End Sub

 

[VetMini]

danhSachLoc = Split(UCase(Join(Application.Transpose(Range("C3:C7")), "|")), "|")
limLo = LBound(danhSachLoc)
limHi = UBound(danhSachLoc)
For Each c In Range("A3:A17")
For i = limLo To limHi ' vòng lặp so sánh trị của cell với danhSachLoc
If InStr(UCase(c.Value), danhSachLoc(i)) Then Exit For
Next i
If i <= limHi Then ' match found
' Chép xuống cột E
End If
Next c

Code ở trên chỉ là căn bản. Thực ra dò range thì có mấy mánh khoé dùng hàm WorksheetFunction Lookup và CountIf.

Dùng Regex có lẽ trông đẹp mắt hơn. Theo thiển ý (IMHO) thì chuỗi ngắn xỉn, dùng Regex không hẳn hiệu quả.

 

[concogia]

Thử dùng code này:

Public Sub Loc()
    Dim I, K, Vung, Kq, Dk, Tam, Cll
    Set Vung = Range([A3], [A5000].End(xlUp))
    Set Dk = Range([C3], [C50].End(xlUp))
    ReDim Kq(1 To Vung.Rows.Count, 1 To 1)
        For Each Cll In Dk
            Tam = VBA.Filter(Application.Transpose(Vung), Cll, True, 1)
            If UBound(Tam) > -1 Then
                For I = LBound(Tam) To UBound(Tam)
                    K = K + 1
                    Kq(K, 1) = Tam(I)
                Next I
            End If
        Next Cll
    [D3:D5000].ClearContents
    [D3].Resize(K) = Kq
End Sub

Thân

 

[hunglam123]

Thử dùng code này:

Public Sub Loc()
    Dim I, K, Vung, Kq, Dk, Tam, Cll
    Set Vung = Range([A3], [A5000].End(xlUp))
    Set Dk = Range([C3], [C50].End(xlUp))
    ReDim Kq(1 To Vung.Rows.Count, 1 To 1)
        For Each Cll In Dk
            Tam = VBA.Filter(Application.Transpose(Vung), Cll, True, 1)
            If UBound(Tam) > -1 Then
                For I = LBound(Tam) To UBound(Tam)
                    K = K + 1
                    Kq(K, 1) = Tam(I)
                Next I
            End If
        Next Cll
    [D3:D5000].ClearContents
    [D3].Resize(K) = Kq
End Sub

Thân

Cảm ơn anh rất nhiều. Code anh chạy rất nhanh và chính xác. Cho em hỏi ví dụ em thêm 1 cột SL ( hoặc có thể nhiều cột nữa ) thì sửa code chổ nào. sẳng giúp em luôn để em khỏi dùng Vlookup em dò nữa mắc công


Với lại nếu Điều kiện lọc trống thì code bị lổi. Thì a có thể sửa lại nếu Rổng thì bỏ qua điều kiện đó

 

[giaiphap]

Cảm ơn anh rất nhiều. Code anh chạy rất nhanh và chính xác. Cho em hỏi ví dụ em thêm 1 cột SL ( hoặc có thể nhiều cột nữa ) thì sửa code chổ nào. sẳng giúp em luôn để em khỏi dùng Vlookup em dò nữa mắc công
View attachment 235999

Với lại nếu Điều kiện lọc trống thì code bị lổi. Thì a có thể sửa lại nếu Rổng thì bỏ qua điều kiện đó
View attachment 236001

Theo giải thuật #2 dùng thử code này.

Public Sub Loc()
    Dim c As Range, SanhSachLoc, limLo%, limHi%, i%
    Dim Arr, k%
    DanhSachLoc = Split(UCase(Join(Application.Transpose(Range([D3], [D50].End(xlUp))), "|")), "|")
    limLo = LBound(DanhSachLoc)
    limHi = UBound(DanhSachLoc)
    [F3:G5000].ClearContents
    k = [A5000].End(xlUp).Row
    ReDim Arr(1 To k, 1 To 2)
    k = 0
    For Each c In Range([A3], [A5000].End(xlUp))
        For i = limLo To limHi
            If InStr(UCase(c.Value), DanhSachLoc(i)) Then Exit For
        Next i
        If i <= limHi Then
            k = k + 1
            Arr(k, 1) = c.Value
            Arr(k, 2) = c.Offset(, 1)
        End If
    Next c
    If k Then [F3].Resize(k, 2) = Arr
End Sub

 

[hunglam123]

Theo giải thuật #2 dùng thử code này.

Public Sub Loc()
    Dim c As Range, SanhSachLoc, limLo%, limHi%, i%
    Dim Arr, k%
    DanhSachLoc = Split(UCase(Join(Application.Transpose(Range([D3], [D50].End(xlUp))), "|")), "|")
    limLo = LBound(DanhSachLoc)
    limHi = UBound(DanhSachLoc)
    [F3:G5000].ClearContents
    k = [A5000].End(xlUp).Row
    ReDim Arr(1 To k, 1 To 2)
    k = 0
    For Each c In Range([A3], [A5000].End(xlUp))
        For i = limLo To limHi
            If InStr(UCase(c.Value), DanhSachLoc(i)) Then Exit For
        Next i
        If i <= limHi Then
            k = k + 1
            Arr(k, 1) = c.Value
            Arr(k, 2) = c.Offset(, 1)
        End If
    Next c
    If k Then [F3].Resize(k, 2) = Arr
End Sub

cảm ơn anh nhiều. Anh cho em hỏi code bài 3 . em sửa lại cho thêm 1 cột nữa sao nó bão lổi anh nhĩ

Sub Loc()
Dim I, K, Vung, Kq, Dk, Tam, Cll
Set Vung = Range([A3], [A5000].End(xlUp))
Set Dk = Range("c3:c10") ' dieu kien
ReDim Kq(1 To Vung.Rows.Count, 1 To 2)
For Each Cll In Dk
If Cll <> "" Then
Tam = VBA.Filter(Application.Transpose(Vung), Cll, True, 1)
If UBound(Tam) > -1 Then
For I = LBound(Tam) To UBound(Tam)
K = K + 1
Kq(K, 1) = Tam(I)
Kq(K, 2) = Tam.Offset(, 1)


Next I
End If
End If
Next Cll
[D35000].ClearContents
[D3].Resize(K, 2) = Kq
End Sub

 

[concogia]

cảm ơn anh nhiều. Anh cho em hỏi code bài 3 . em sửa lại cho thêm 1 cột nữa sao nó bão lổi anh nhĩ

Sub Loc()
Dim I, K, Vung, Kq, Dk, Tam, Cll
Set Vung = Range([A3], [A5000].End(xlUp))
Set Dk = Range("c3:c10") ' dieu kien
ReDim Kq(1 To Vung.Rows.Count, 1 To 2)
For Each Cll In Dk
If Cll <> "" Then
Tam = VBA.Filter(Application.Transpose(Vung), Cll, True, 1)
If UBound(Tam) > -1 Then
For I = LBound(Tam) To UBound(Tam)
K = K + 1
Kq(K, 1) = Tam(I)
Kq(K, 2) = Tam.Offset(, 1)


Next I
End If
End If
Next Cll
[D35000].ClearContents
[D3].Resize(K, 2) = Kq
End Sub

Bạn xem File
Bài này mình sử dụng Filter nên nếu 2 hoặc nhiều hơn điều kiện lọc xuất hiện trong 1 cell dữ liệu thì nó sẽ ....lấy tất. Ủa, mà quên, lọc kiểu nào nó cũng lấy hết mà. Híc
Nhưng mình nghĩ dữ liệu thật của bạn bạn kiểm soát được
Thân