Xin chào befaint,
Bài này nếu lập trình thì điều kiện cột B1 split ra một mảng, dò theo vùng bên sheet order ra mảng mới rồi gán xuống sheet
Cảm ơn bạn đã quan tâm, nếu có thể nhờ bạn giúp đỡ OT theo cách này với ạ:
Product Category có nhiều giá trị giống customer không bạn
Có bạn ạ, mỗi giá trị ngăn cách nhau bởi dấu ";" bạn ạ
Option Explicit
Private Function CheckCriteria(ByVal strChecking As String, ByVal strCriteria As String, _
Optional ByVal blnMatchCase As Boolean = False) As Boolean
'Tra ve True neu tim thay chuoi dieu kien trong strChecking'
'strChecking: Chuoi can kiem tra'
'strCriteria: Chuoi chua cac dieu kien loc'
' Neu khong nhap gi (strCriteria = Empty) tuc la thoa moi dieu kien'
'blnMatchCase: True - phan biet chu hoa/ thuong va nguoc lai. Mac dinh False '
Const strDeli = ";"
Dim item As Variant, strFind As String, MatchCase As VbCompareMethod
If Len(strCriteria) = 0 Then CheckCriteria = True: Exit Function
If blnMatchCase = False Then MatchCase = vbTextCompare Else MatchCase = vbBinaryCompare
For Each item In VBA.Split(strCriteria, strDeli)
strFind = item
If InStr(1, strChecking, strFind, MatchCase) > 0 Then
CheckCriteria = True
Exit For
End If
Next item
End FunctionBác befaint lẹ quá mà 4h mình tan ca rồi nên nếu chưa ổn thì tối mình mới xem giúp bạn được, bạn thông cảm nhé. (mình mới viết được nửa đường
)Dùng Power query
Bạn thử code nếu lọc tất cả thì bỏ trống nhé.
Sub loc()
Dim arr, kq, i As Long, lr As Long, T1, T2, a As Long, b As Integer, c As Integer, dk As String, dks As String
Dim m As Boolean, n As Boolean, k As Integer, j As Integer
With Sheets("Orders")
lr = .Range("H" & Rows.Count).End(xlUp).Row
arr = .Range("A2:J" & lr).Value
ReDim kq(1 To UBound(arr), 1 To 10)
End With
With Sheets("Filter")
T1 = Split(";" & .Range("b1").Value, ";")
T2 = Split(";" & .Range("b2").Value, ";")
b = UBound(T1)
c = UBound(T2)
For i = 1 To UBound(arr)
dk = arr(i, 8)
dks = arr(i, 10)
m = False: n = False
For k = 1 To b
If InStr(dk, T1(k)) Then
m = True
Exit For
End If
Next k
For k = 1 To c
If InStr(dks, T2(k)) Then
n = True
Exit For
End If
Next k
If m = True And n = True Then
a = a + 1
For j = 1 To 10
kq(a, j) = arr(i, j)
Next j
End If
Next i
lr = .Range("H" & Rows.Count).End(xlUp).Row
If lr > 3 Then .Range("A4:J" & lr).ClearContents
If a Then .Range("A4:J4").Resize(a).Value = kq
End With
End SubDạ OT muốn sử dụng VBA bài này Bạn ạ, cảm ơn bạn nhiều.
Cảm ơn befaint, OT sẽ code thử 1 sub để ứng dụng hàm "CheckCriteria" của Bạn ạ.
Xin chào snow25,
Bạn xóa cái dấu * ở cột B2 đi thì có kết quả.
Cảm ơn @snow25 nhiều ạ,
A! OT xử lý được rồi cảm ơn @snow25 nhiều ạ.
...
T1 = Split(";" & UCase(.Range("b1").Value), ";")
T2 = Split(";" & UCase(.Range("b2").Value), ";")
...
dk = UCase(arr(i, 8))
dks = UCase(arr(i, 10))
...Bạn tìm hiểu lại cấu trúc hàm instr xem sao, chỗ vbtextcompare với vbbinarycompare có thể sẽ gọn hơn
Dạ thôi Bạn ạ, rẹt cái ra kết quả luôn là ưng lắm rồi ạ, còn gọn & đẹp thì để sau nếu cái đầu của OT nó được cải thiện hơn ạ.
Có cách nào bỏ 2 biến "m" và "n" không?
Con chào Bác @HieuCD ,Có cách nào bỏ 2 biến "m" và "n" không?
Trời ạ, mình chỉ gợi ý code gọn và chạy nhanh hơn chút xíu mờ
Dạ vầng Bác ơi, con cũng thấy cần thêm mấy chỗ đó ạ.
