Lọc dữ liệu-chứa nhiều điều kiện lọc? (2 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 2 (Thành viên: 0, Khách: 2)
Hoàng Nhật Phương

Hoàng Nhật Phương

Thành viên gắn bó
Tham gia
5/11/15
Bài viết
1,895
Được thích
1,219
Xin chào các bạn,
OT muốn trích lọc dữ liệu theo điều kiện nhiều điều kiện ngăn cách nhau bởi dấu ";" cụ thể xin phép được mô tả trong tập tin gửi kèm.
Nhờ các bạn xem & giúp đỡ OT với ạ.
 

File đính kèm

NHN_Phương đã viết:
Xin chào các bạn,
OT muốn trích lọc dữ liệu theo điều kiện nhiều điều kiện ngăn cách nhau bởi dấu ";" cụ thể xin phép được mô tả trong tập tin gửi kèm.
Nhờ các bạn xem & giúp đỡ OT với ạ.
Nhấp chuột vào đây để mở rộng...
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òn nếu là thông thường thì dường như không lọc được, nếu muốn thì tìm hiểu thêm về advanced filter
 
Nhattanktnn đã viết:
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òn nếu là thông thường thì dường như không lọc được, nếu muốn thì tìm hiểu thêm về advanced filter
Nhấp chuột vào đây để mở rộng...
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 ạ:
" 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"
 
NHN_Phương đã viết:
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 ạ:
" 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"
Nhấp chuột vào đây để mở rộng...
Product Category có nhiều giá trị giống customer không bạn
 
PHP: 
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 Function

Áp dụng đại khái:
- Giả sử lọc không phân biệt chữ hoa/ thường
- Điều kiện ban đầu: dk1 = B1, dk2 = B2
- Chép bảng dữ liệu vào mảng.
- Xét các phần tử mảng:
ten_khach=...
loại_hang=...
If CheckCriteria(ten_khach, dk1) = True then
If CheckCriteria(loại_hang, dk2) = True then
'lấy dữ liệu vào mảng kết quả
End If
End If
 

File đính kèm

NHN_Phương đã viết:
Xin chào các bạn,
OT muốn trích lọc dữ liệu theo điều kiện nhiều điều kiện ngăn cách nhau bởi dấu ";" cụ thể xin phép được mô tả trong tập tin gửi kèm.
Nhờ các bạn xem & giúp đỡ OT với ạ.
Nhấp chuột vào đây để mở rộng...
Bạn thử code nếu lọc tất cả thì bỏ trống nhé.
Mã: 
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 Sub
 
excel_lv1.5 đã viết:
Dùng Power query
Nhấp chuột vào đây để mở rộng...
Dạ OT muốn sử dụng VBA bài này Bạn ạ, cảm ơn bạn nhiều.
Bài đã được tự động gộp:

befaint đã viết:
PHP: 
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 Function

Áp dụng đại khái:
- Giả sử lọc không phân biệt chữ hoa/ thường
- Điều kiện ban đầu: dk1 = B1, dk2 = B2
- Chép bảng dữ liệu vào mảng.
- Xét các phần tử mảng:
ten_khach=...
loại_hang=...
If CheckCriteria(ten_khach, dk1) = True then
If CheckCriteria(loại_hang, dk2) = True then
'lấy dữ liệu vào mảng kết quả
End If
End If
Nhấp chuột vào đây để mở rộng...
Cảm ơn befaint, OT sẽ code thử 1 sub để ứng dụng hàm "CheckCriteria" của Bạn ạ.

snow25 đã viết:
Bạn thử code nếu lọc tất cả thì bỏ trống nhé.
Mã: 
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 Sub
Nhấp chuột vào đây để mở rộng...
Xin chào snow25,
Code này của bạn OT copy về xóa dữ liệu cũ ở sheet finter trước sau đó chạy code thì không xuất hiện kết quả ? ở sheet Oders OT cũng bỏ lọc rồi Bạn ạ.
 
Lần chỉnh sửa cuối:
NHN_Phương đã viết:
Dạ OT muốn sử dụng VBA bài này Bạn ạ, cảm ơn bạn nhiều.
Bài đã được tự động gộp:


Cảm ơn befaint, OT sẽ code thử 1 sub để ứng dụng hàm "CheckCriteria" của Bạn ạ.


Xin chào snow25,
Code này của bạn OT copy về xóa dữ liệu cũ ở sheet finter trước sau đó chạy code thì không xuất hiện kết quả ? ở sheet Oders OT cũng bỏ lọc rồi Bạn ạ.
Nhấp chuột vào đây để mở rộng...
Bạn xóa cái dấu * ở cột B2 đi thì có kết quả.
 
snow25 đã viết:
Bạn xóa cái dấu * ở cột B2 đi thì có kết quả.
Nhấp chuột vào đây để mở rộng...
Cảm ơn @snow25 nhiều ạ,
OT xóa dấu "*" ở ô B2 kết quả OK rồi bạn ạ, bạn cho hỏi thêm nếu không phân biệt chữ hoa chữ thường thì xử lý những chỗ nào ạ?
Bài đã được tự động gộp:

snow25 đã viết:
Bạn xóa cái dấu * ở cột B2 đi thì có kết quả.
Nhấp chuột vào đây để mở rộng...
A! OT xử lý được rồi cảm ơn @snow25 nhiều ạ.
Mã: 
...
T1 = Split(";" & UCase(.Range("b1").Value), ";")
        T2 = Split(";" & UCase(.Range("b2").Value), ";")
...
            dk = UCase(arr(i, 8))
            dks = UCase(arr(i, 10))
            ...
 
Lần chỉnh sửa cuối:
NHN_Phương đã viết:
Cảm ơn @snow25 nhiều ạ,
OT xóa dấu "*" ở ô B2 kết quả OK rồi bạn ạ, bạn cho hỏi thêm nếu không phân biệt chữ hoa chữ thường thì xử lý những chỗ nào ạ?
Bài đã được tự động gộp:


A! OT xử lý được rồi cảm ơn @snow25 nhiều ạ.
Mã: 
...
T1 = Split(";" & UCase(.Range("b1").Value), ";")
        T2 = Split(";" & UCase(.Range("b2").Value), ";")
...
            dk = UCase(arr(i, 8))
            dks = UCase(arr(i, 10))
            ...
Nhấp chuột vào đây để mở rộng...
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
 
Nhattanktnn đã viết:
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
Nhấp chuột vào đây để mở rộng...
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 ạ.
 
snow25 đã viết:
Bạn thử code nếu lọc tất cả thì bỏ trống nhé.
Mã: 
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 Sub
Nhấp chuột vào đây để mở rộng...
Có cách nào bỏ 2 biến "m" và "n" không? :p
 
HieuCD đã viết:
Có cách nào bỏ 2 biến "m" và "n" không? :p
Nhấp chuột vào đây để mở rộng...
Con chào Bác @HieuCD ,
Cảm ơn Bác đã quan tâm vấn đề của con ạ.
Bác mà tham gia, nhờ Bác xử lý giúp con thêm 2 điều kiện nữa lọc trong ô D1,D2,E2 theo cột "Order Date" & "Profit" với ạ:
Bắt lỗi điều kiện nếu có điều kiện trong ô D1 & D2 thì phải đủ cả 2 điều kiện từ ngày đến ngày và ngày trong ô D2 lớn hơn ngày trong ô D1thì mới code mới chạy ạ .

1609341748784.png
 

File đính kèm

NHN_Phương đã viết:
Con chào Bác @HieuCD ,
Cảm ơn Bác đã quan tâm vấn đề của con ạ.
Bác mà tham gia, nhờ Bác xử lý giúp con thêm 2 điều kiện nữa lọc trong ô D1,D2,E2 theo cột "Order Date" & "Profit" với ạ:
Bắt lỗi điều kiện nếu có điều kiện trong ô D1 & D2 thì phải đủ cả 2 điều kiện từ ngày đến ngày và ngày trong ô D2 lớn hơn ngày trong ô D1thì mới code mới chạy ạ .

View attachment 252181
Nhấp chuột vào đây để mở rộng...
Trời ạ, mình chỉ gợi ý code gọn và chạy nhanh hơn chút xíu mờ
 
NHN_Phương đã viết:
Ùi, con chào Thầy ạ.
Con cảm ơn Thầy đã quan tâm đến vấn đề của con ạ.
Dạ điều kiện cột này có thể lựa chọn đầy đủ các điều kiện so sánh: (>=<) Thầy ạ.
Nhấp chuột vào đây để mở rộng...
Xử lý các điều kiện "<", "<=", "=", ">=", ">" không phải chuyện dễ.
Híc!
 
Ba Tê đã viết:
Xử lý các điều kiện "<", "<=", "=", ">=", ">" không phải chuyện dễ.
Híc!
Nhấp chuột vào đây để mở rộng...
Dạ vầng Thầy ạ, vậy có thể thiết kế thêm một ô nào nữa để lựa chọn các điều kiện "<", "<=", "=", ">=", ">" này được không ạ Thầy?
Ví dụ trong tập tin đính kèm con đã tách điều kiện trong ô E2 thành 2 ô E2 và F2 Thầy ạ.
 

File đính kèm

NHN_Phương đã viết:
Dạ vầng Thầy ạ, vậy có thể thiết kế thêm một ô nào nữa để lựa chọn các điều kiện "<", "<=", "=", ">=", ">" này được không ạ Thầy?
Ví dụ trong tập tin đính kèm con đã tách điều kiện trong ô E2 thành 2 ô E2 và F2 Thầy ạ.
Nhấp chuột vào đây để mở rộng...
Bạn thử code này xem đúng yêu cầu chưa:
Mã: 
Option Explicit
Sub NTKTNN()
Dim sArr(), dArr(), CusName, ProCat, fDate As Long, tDate As Long, Profit As String, Bo As Boolean
Dim i As Long, J As Long, K As Long
Application.ScreenUpdating = False
With Sheets("Filter")
    CusName = Split(.Range("B1").Value, ";")
    ProCat = Split(.Range("B2").Value, ";")
    fDate = .Range("D1").Value
    tDate = .Range("D2").Value
    Profit = .Range("E2").Value
End With
With Sheets("Orders")
    sArr = .Range("A1:J" & .Cells(.Rows.Count, "A").End(xlUp).Rows).Value
    ReDim dArr(1 To UBound(sArr), 1 To UBound(sArr, 2))
    For i = 1 To UBound(sArr, 1)
        If UBound(CusName) >= 0 Then
            For J = 0 To UBound(CusName)
                If InStr(1, sArr(i, 8), CusName(J), 1) > 0 Then Bo = True: Exit For
            Next
            If Bo = False Then GoTo Next_I
            Bo = False
        End If
        If UBound(ProCat) >= 0 Then
            For J = 0 To UBound(ProCat)
                If InStr(1, sArr(i, 10), ProCat(J), 1) > 0 Then Bo = True: Exit For
            Next
            If Bo = False Then GoTo Next_I
            Bo = False
        End If
        If fDate > 0 And tDate > 0 Then
            If sArr(i, 2) >= fDate And sArr(i, 2) <= tDate Then Bo = True
            If Bo = False Then GoTo Next_I
            Bo = False
        End If
        If Profit <> "" Then
            If Evaluate(sArr(i, 6) & Profit) Then Bo = True
            If Bo = False Then GoTo Next_I
        End If
        K = K + 1
        For J = 1 To UBound(sArr, 2)
            dArr(K, J) = sArr(i, J)
        Next
Next_I:
    Next
End With
Sheets("Filter").Range("A4:J10000").ClearContents
Sheets("Filter").Range("A4").Resize(UBound(sArr), UBound(sArr, 2)) = dArr
Application.ScreenUpdating = True
End Sub
 

File đính kèm

Lần chỉnh sửa cuối:
befaint đã viết:
Mỗi vòng lặp lại phải tính lại UBound(CusName)

Dùng For each thì không cần kiểm tra Ubound.
Nhấp chuột vào đây để mở rộng...
Góp ý rất hay bác ạ, đúng là for each thì không cần phải kiểm tra ubound. Nhưng nếu không kiểm tra vậy thì một số trường hợp không có điều kiện (người để trống) code vẫn duyệt qua nó (em đang ví dụ với cusname), như vậy nó sẽ tính cái boolean là false và next sang i khác ạ
 
Nhattanktnn đã viết:
Góp ý rất hay bác ạ, đúng là for each thì không cần phải kiểm tra ubound. Nhưng nếu không kiểm tra vậy thì một số trường hợp không có điều kiện (người để trống) code vẫn duyệt qua nó (em đang ví dụ với cusname), như vậy nó sẽ tính cái boolean là false và next sang i khác ạ
Nhấp chuột vào đây để mở rộng...
Thì mình kiểm tra và oánh dấu ngay từ đầu ấy.

Dim flagCusName as boolean
If len(.Range("B1").Value) > 0 then
flagCusName = True
CusName = Split(.Range("B1").Value, ";")
Else
flagCusName = False
End if
'...
For i = 1 To UBound(sArr, 1)
If flagCusName = True then
For Each cuName in CusName
'...
Next
'...
Else
'...
End If
 
befaint đã viết:
Thì mình kiểm tra và oánh dấu ngay từ đầu ấy.

Dim flagCusName as boolean
If len(.Range("B1").Value) > 0 then
flagCusName = True
CusName = Split(.Range("B1").Value, ";")
Else
flagCusName = False
End if
'...
For i = 1 To UBound(sArr, 1)
If flagCusName = True then
For Each cuName in CusName
'...
Next
'...
Else
'...
End If
Nhấp chuột vào đây để mở rộng...
Sao em thấy hình như bớt được khúc if nhưng phải tạo nhiều biến hơn phải không bác? :D
 
befaint đã viết:
Ợ. Code xem ở giải thuật chứ đâu đi đếm biến với đếm dòng. @@
Nhấp chuột vào đây để mở rộng...
Thì em cũng biết code ai đâu đi đếm biến và dòng :D, nhưng em chỉ muốn biết theo cách đó có tối ưu hơn không, giả sử hai code tương đương nhau thì vẫn nên tiết kiệm biến và dòng cho dễ nhìn chứ ạ
 
NHN_Phương đã viết:
Dạ vầng Thầy ạ, vậy có thể thiết kế thêm một ô nào nữa để lựa chọn các điều kiện "<", "<=", "=", ">=", ">" này được không ạ Thầy?
Ví dụ trong tập tin đính kèm con đã tách điều kiện trong ô E2 thành 2 ô E2 và F2 Thầy ạ.
Nhấp chuột vào đây để mở rộng...
Dùng ADO để Select bảng ban đầu. Với điều kiện ghép như [Customer name] dạng "a;b;c" ta dùng Replace và nối chuỗi để thay thế thành ([Customer name] like "%a%" OR [Customer name] like "%b%" OR [Customer name] like "%c%") rồi đưa vào điều kiện where thôi. Với điều kiện > hay >= dùng nối chuỗi bình thường.
 
Lần chỉnh sửa cuối:
Nhattanktnn đã viết:
Bạn thử code này xem đúng yêu cầu chưa:
Mã: 
Option Explicit
Sub NTKTNN()
Dim sArr(), dArr(), CusName, ProCat, fDate As Long, tDate As Long, Profit As String, Bo As Boolean
Dim i As Long, J As Long, K As Long
Application.ScreenUpdating = False
With Sheets("Filter")
    CusName = Split(.Range("B1").Value, ";")
    ProCat = Split(.Range("B2").Value, ";")
    fDate = .Range("D1").Value
    tDate = .Range("D2").Value
    Profit = .Range("E2").Value
End With
With Sheets("Orders")
    sArr = .Range("A1:J" & .Cells(.Rows.Count, "A").End(xlUp).Rows).Value
    ReDim dArr(1 To UBound(sArr), 1 To UBound(sArr, 2))
    For i = 1 To UBound(sArr, 1)
        If UBound(CusName) >= 0 Then
            For J = 0 To UBound(CusName)
                If InStr(1, sArr(i, 8), CusName(J), 1) > 0 Then Bo = True: Exit For
            Next
            If Bo = False Then GoTo Next_I
            Bo = False
        End If
        If UBound(ProCat) >= 0 Then
            For J = 0 To UBound(ProCat)
                If InStr(1, sArr(i, 10), ProCat(J), 1) > 0 Then Bo = True: Exit For
            Next
            If Bo = False Then GoTo Next_I
            Bo = False
        End If
        If fDate > 0 And tDate > 0 Then
            If sArr(i, 2) >= fDate And sArr(i, 2) <= tDate Then Bo = True
            If Bo = False Then GoTo Next_I
            Bo = False
        End If
        If Profit <> "" Then
            If Evaluate(sArr(i, 6) & Profit) Then Bo = True
            If Bo = False Then GoTo Next_I
        End If
        K = K + 1
        For J = 1 To UBound(sArr, 2)
            dArr(K, J) = sArr(i, J)
        Next
Next_I:
    Next
End With
Sheets("Filter").Range("A4:J10000").ClearContents
Sheets("Filter").Range("A4").Resize(UBound(sArr), UBound(sArr, 2)) = dArr
Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Mình thường viết kiểu nầy
Mã: 
...
With Sheets("Filter")
    CusName = Split(";" & .Range("B1").Value, ";")
...
    For i = 1 To UBound(sArr, 1)      
            For J = 1 To UBound(CusName)
                If InStr(1, sArr(i, 8), CusName(J), 1) = 0 Then GoTo Next_I
            Next
...
 
HieuCD đã viết:
For J = 1 To UBound(CusName) If InStr(1, sArr(i, 8), CusName(J), 1) = 0 Then GoTo Next_I
Nhấp chuột vào đây để mở rộng...
Ủa bác Hiếu, ubound của mảng split gốc 0 mà bác, với lại mảng cusname có nhiều phần tử, nếu duyệt phần tử đầu không có thì duyệt tiếp chứ theo em thấy code đó nếu gặp phần tử đầu tiên không có là next luôn rồi bác?
 
Nhattanktnn đã viết:
Ủa bác Hiếu, ubound của mảng split gốc 0 mà bác, với lại mảng cusname có nhiều phần tử, nếu duyệt phần tử đầu không có thì duyệt tiếp chứ theo em thấy code đó nếu gặp phần tử đầu tiên không có là next luôn rồi bác?
Nhấp chuột vào đây để mở rộng...
Mã: 
CusName = Split(";" & .Range("B1").Value, ";")
Do thêm ";" & nên CusName (0) là giá trị trống bỏ qua. chỉ xét từ CusName (1)
Nhầm, chỉnh lại :)
Mã: 
...
With Sheets("Filter")
    CusName = Split(";" & .Range("B1").Value, ";")
...
    For i = 1 To UBound(sArr, 1)     
            For J = 1 To UBound(CusName)
                If InStr(1, sArr(i, 8), CusName(J), 1) > 0 Then exit for
            Next
            If J = 1 + UBound(CusName) Then GoTo Next_I
...
 
HieuCD đã viết:
Mã: 
CusName = Split(";" & .Range("B1").Value, ";")
Do thêm ";" & nên CusName (0) là giá trị trống bỏ qua. chỉ xét từ CusName (1)
Nhầm, chỉnh lại :)
Mã: 
...
With Sheets("Filter")
    CusName = Split(";" & .Range("B1").Value, ";")
...
    For i = 1 To UBound(sArr, 1)    
            For J = 1 To UBound(CusName)
                If InStr(1, sArr(i, 8), CusName(J), 1) > 0 Then exit for
            Next
            If J = 1 + UBound(CusName) Then GoTo Next_I
...
Nhấp chuột vào đây để mở rộng...
Em cũng chưa thử nhưng nếu như trường hợp họ chỉ filter ngày tháng hoặc trường khác, không filter cusname( để trống) thì trong trường hợp này code đang thiếu điều kiện if ubound(cusname)>0 phải không bác?
Bài đã được tự động gộp:

HieuCD đã viết:
If J = 1 + UBound(CusName)
Nhấp chuột vào đây để mở rộng...
Mà em thấy cái này tuy đơn giản nhưng hay nè, lúc viết không nghĩ ra được
 
Nhattanktnn đã viết:
Em cũng chưa thử nhưng nếu như trường hợp họ chỉ filter ngày tháng hoặc trường khác, không filter cusname( để trống) thì trong trường hợp này code đang thiếu điều kiện if ubound(cusname)>0 phải không bác?
Bài đã được tự động gộp:


Mà em thấy cái này tuy đơn giản nhưng hay nè, lúc viết không nghĩ ra được
Nhấp chuột vào đây để mở rộng...
CusName = Split(";" & .Range("B1").Value, ";")
CusName luôn là mảng và có ít nhất 2 phần tử, CusName(0) là phần tử thêm vào không xét
Nếu .Range("B1").Value để trống thì CusName(1)="" và InStr(1, sArr(i, 8), CusName(1), 1) sẽ "> 0" thỏa điều kiện, không cần xét điều kiện if ubound(cusname)>0
 
HieuCD đã viết:
CusName = Split(";" & .Range("B1").Value, ";")
CusName luôn là mảng và có ít nhất 2 phần tử, CusName(0) là phần tử thêm vào không xét
Nếu .Range("B1").Value để trống thì CusName(1)="" và InStr(1, sArr(i, 8), CusName(1), 1) sẽ "> 0" thỏa điều kiện, không cần xét điều kiện if ubound(cusname)>0
Nhấp chuột vào đây để mở rộng...
Lúc đầu em cứ nghĩ cái này nó chỉ bằng 0
1609433051925.png
Bác Hiếu có nhiều tư duy hay thật, rất đáng học hỏi. Cảm ơn bác đã chia sẻ
 
Hau151978 đã viết:
Dùng ADO để Select bảng ban đầu. Với điều kiện ghép như [Customer name] dạng "a;b;c" ta dùng Replace và nối chuỗi để thay thế thành ([Customer name] like "%a%" OR [Customer name] like "%b%" OR [Customer name] like "%c%") rồi đưa vào điều kiện where thôi. Với điều kiện > hay >= dùng nối chuỗi bình thường.
Nhấp chuột vào đây để mở rộng...

Xin chào @Hau151978,
Cảm ơn Bạn đã tham gia ạ.
Bạn có thể viết giúp OT câu lệnh select đầy đủ với tập tin tại bài 28 được không ạ?

Nhattanktnn đã viết:
Bạn thử code này xem đúng yêu cầu chưa:
Mã: 
Option Explicit
Sub NTKTNN()
Dim sArr(), dArr(), CusName, ProCat, fDate As Long, tDate As Long, Profit As String, Bo As Boolean
Dim i As Long, J As Long, K As Long
Application.ScreenUpdating = False
With Sheets("Filter")
    CusName = Split(.Range("B1").Value, ";")
    ProCat = Split(.Range("B2").Value, ";")
    fDate = .Range("D1").Value
    tDate = .Range("D2").Value
    Profit = .Range("E2").Value
End With
With Sheets("Orders")
    sArr = .Range("A1:J" & .Cells(.Rows.Count, "A").End(xlUp).Rows).Value
    ReDim dArr(1 To UBound(sArr), 1 To UBound(sArr, 2))
    For i = 1 To UBound(sArr, 1)
        If UBound(CusName) >= 0 Then
            For J = 0 To UBound(CusName)
                If InStr(1, sArr(i, 8), CusName(J), 1) > 0 Then Bo = True: Exit For
            Next
            If Bo = False Then GoTo Next_I
            Bo = False
        End If
        If UBound(ProCat) >= 0 Then
            For J = 0 To UBound(ProCat)
                If InStr(1, sArr(i, 10), ProCat(J), 1) > 0 Then Bo = True: Exit For
            Next
            If Bo = False Then GoTo Next_I
            Bo = False
        End If
        If fDate > 0 And tDate > 0 Then
            If sArr(i, 2) >= fDate And sArr(i, 2) <= tDate Then Bo = True
            If Bo = False Then GoTo Next_I
            Bo = False
        End If
        If Profit <> "" Then
            If Evaluate(sArr(i, 6) & Profit) Then Bo = True
            If Bo = False Then GoTo Next_I
        End If
        K = K + 1
        For J = 1 To UBound(sArr, 2)
            dArr(K, J) = sArr(i, J)
        Next
Next_I:
    Next
End With
Sheets("Filter").Range("A4:J10000").ClearContents
Sheets("Filter").Range("A4").Resize(UBound(sArr), UBound(sArr, 2)) = dArr
Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn nhiều nhiều ạ, diễn đàn giờ nhiều cao thủ quáa ahiii
-------
Xin kính chúc tất cả mọi người đón chào một năm mới sức khỏe tốt luôn hạnh phúc và thành công trong cuộc sống.
 
@NHN_Phương
Mã: 
Function ConvertCriteria(Field As String, Criteria As String) As String
    If Criteria = "*" Then
        ConvertCriteria = "TRUE"
    Else
        ConvertCriteria = "([" & Field & "] LIKE ""%" & Replace(Criteria, ";", "%"" OR [" & Field & "] LIKE ""%") & "%"")"
    End If
End Function
Sub ABC()
    Dim cn As New ADODB.Connection, rs As New ADODB.Recordset
    Dim s As String, tmp As String
    s = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0 XML;HDR=YES"";"
    cn.Open s
    s = "SELECT * FROM [Orders$] WHERE "
    s = s & ConvertCriteria("Customer Name", Sheets("Filter").Range("B1"))
    s = s & " AND " & ConvertCriteria("Product category", Sheets("Filter").Range("B2"))
    s = s & " AND [Order date] >=#" & Sheets("Filter").Range("D1") & "#"
    s = s & " AND [Order date] <=#" & Sheets("Filter").Range("D2") & "#"
    tmp = Sheets("Filter").Range("E2") & Sheets("Filter").Range("F2")
    If tmp = "=0" Then
        s = s & " AND (Profit=0 OR Profit is null)"
    Else
        s = s & " AND Profit" & tmp
    End If
    rs.Open s, cn
    Sheets("Filter").Range("A4:J1000000").ClearContents
    Sheets("Filter").Range("A4").CopyFromRecordset rs
    rs.Close
    cn.Close
End Sub
Hai ô điều kiện Profit nên ghép lại thành 1 ô cho nhanh.
 
Hau151978 đã viết:
@NHN_Phương
Mã: 
Function ConvertCriteria(Field As String, Criteria As String) As String
    If Criteria = "*" Then
        ConvertCriteria = "TRUE"
    Else
        ConvertCriteria = "([" & Field & "] LIKE ""%" & Replace(Criteria, ";", "%"" OR [" & Field & "] LIKE ""%") & "%"")"
    End If
End Function
Sub ABC()
    Dim cn As New ADODB.Connection, rs As New ADODB.Recordset
    Dim s As String, tmp As String
    s = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0 XML;HDR=YES"";"
    cn.Open s
    s = "SELECT * FROM [Orders$] WHERE "
    s = s & ConvertCriteria("Customer Name", Sheets("Filter").Range("B1"))
    s = s & " AND " & ConvertCriteria("Product category", Sheets("Filter").Range("B2"))
    s = s & " AND [Order date] >=#" & Sheets("Filter").Range("D1") & "#"
    s = s & " AND [Order date] <=#" & Sheets("Filter").Range("D2") & "#"
    tmp = Sheets("Filter").Range("E2") & Sheets("Filter").Range("F2")
    If tmp = "=0" Then
        s = s & " AND (Profit=0 OR Profit is null)"
    Else
        s = s & " AND Profit" & tmp
    End If
    rs.Open s, cn
    Sheets("Filter").Range("A4:J1000000").ClearContents
    Sheets("Filter").Range("A4").CopyFromRecordset rs
    rs.Close
    cn.Close
End Sub
Hai ô điều kiện Profit nên ghép lại thành 1 ô cho nhanh.
Nhấp chuột vào đây để mở rộng...

Cảm ơn Bạn @Hau151978 nhiều ạ, kết quả đúng ý OT rồi ạ. Sử dụng câu lệnh truy vấn luôn ngắn gọn và cho kết chính xác thật.
@Nhattanktnn , code bài 30 sau khi OT bỏ trống B2 thì lấy thêm 2 dòng dữ liệu màu đỏ, nhờ bạn xem giúp ạ.
Hoặc trong trường hợp B1 không nhập gì thì code bị lỗi "Type mismatch" tại dòng: If Evaluate(sArr(i, 6) & Profit) Then

1609478582603.png
 
Lần chỉnh sửa cuối:
NHN_Phương đã viết:
vậy có thể thiết kế thêm một ô nào nữa để lựa chọn các điều kiện "<", "<=", "=", ">=", ">" được không
Nhấp chuột vào đây để mở rộng...
phuongvq123 đã viết:
Bác có thể hướng dẫn em cách làm file này bằng query được không ạ
Nhấp chuột vào đây để mở rộng...
Kết hợp 2 yêu cầu ở trên, các điều kiện lọc Customer name và Category nằm ở 2 bảng, Oder date from, date to, Profit Compare mode, Profit mỗi thông số nằm ở 1 ô như hình sau, thì Power query đơn giản lắm.

1609495779015.png

- Bỏ trống Customer name hoặc Category là lấy hết theo điều kiện from - to và điều kiện Profit
- Bỏ trống Profit Compare mode cũng lấy hết theo các điều kiện khác

PHP: 
let
    DFrom=Excel.CurrentWorkbook(){[Name="DateCondition"]}[Content]{0}[Column1],
    DTo=Excel.CurrentWorkbook(){[Name="DateCondition"]}[Content]{1}[Column1],
    CompareMode=Excel.CurrentWorkbook(){[Name="ProfitCondition"]}[Content]{0}[Column1],
    ComparedProfit=Excel.CurrentWorkbook(){[Name="ProfitCondition"]}[Content]{0}[Column2],
    Source = Excel.CurrentWorkbook(){[Name="Table3"]}[Content],
    MergedCustomer = Table.NestedJoin(Source, {"Customer Name"}, CusName, {"Customer Name"}, "CusName",
        if List.NonNullCount(CusName[Customer Name]) > 0  then JoinKind.Inner else JoinKind.LeftOuter),
    MergedCategory = Table.NestedJoin(MergedCustomer, {"Product Category"}, CategoryName, {"Product Category"}, "CategoryName",
        if List.NonNullCount(CategoryName[Product Category]) > 0  then JoinKind.Inner else JoinKind.LeftOuter),
    DateFilter=Table.SelectRows(MergedCategory, each [Order Date] >= DFrom and [Order Date] <= DTo),
    ProfitFilter=Table.SelectRows(DateFilter, each
        if CompareMode = ">" then [Profit] > ComparedProfit
        else if CompareMode = ">=" then [Profit] >= ComparedProfit
        else if CompareMode = "<" then [Profit] < ComparedProfit
        else if CompareMode = "<=" then [Profit] <= ComparedProfit
        else if CompareMode = "=" then [Profit] = ComparedProfit
        else true)
in
    ProfitFilter
 

File đính kèm

ptm0412 đã viết:
Kết hợp 2 yêu cầu ở trên, các điều kiện lọc Customer name và Category nằm ở 2 bảng, Oder date from, date to, Profit Compare mode, Profit mỗi thông số nằm ở 1 ô như hình sau, thì Power query đơn giản lắm.

View attachment 252299

- Bỏ trống Customer name hoặc Category là lấy hết theo điều kiện from - to và điều kiện Profit
- Bỏ trống Profit Compare mode cũng lấy hết theo các điều kiện khác

PHP: 
let
    DFrom=Excel.CurrentWorkbook(){[Name="DateCondition"]}[Content]{0}[Column1],
    DTo=Excel.CurrentWorkbook(){[Name="DateCondition"]}[Content]{1}[Column1],
    CompareMode=Excel.CurrentWorkbook(){[Name="ProfitCondition"]}[Content]{0}[Column1],
    ComparedProfit=Excel.CurrentWorkbook(){[Name="ProfitCondition"]}[Content]{0}[Column2],
    Source = Excel.CurrentWorkbook(){[Name="Table3"]}[Content],
    MergedCustomer = Table.NestedJoin(Source, {"Customer Name"}, CusName, {"Customer Name"}, "CusName",
        if List.NonNullCount(CusName[Customer Name]) > 0  then JoinKind.Inner else JoinKind.LeftOuter),
    MergedCategory = Table.NestedJoin(MergedCustomer, {"Product Category"}, CategoryName, {"Product Category"}, "CategoryName",
        if List.NonNullCount(CategoryName[Product Category]) > 0  then JoinKind.Inner else JoinKind.LeftOuter),
    DateFilter=Table.SelectRows(MergedCategory, each [Order Date] >= DFrom and [Order Date] <= DTo),
    ProfitFilter=Table.SelectRows(DateFilter, each
        if CompareMode = ">" then [Profit] > ComparedProfit
        else if CompareMode = ">=" then [Profit] >= ComparedProfit
        else if CompareMode = "<" then [Profit] < ComparedProfit
        else if CompareMode = "<=" then [Profit] <= ComparedProfit
        else if CompareMode = "=" then [Profit] = ComparedProfit
        else true)
in
    ProfitFilter
Nhấp chuột vào đây để mở rộng...
Dạ vầng, con cảm ơn chú Mỹ đã chỉ dẫn thêm chon con cách nữa ạ.
Nhưng con con chưa xài PQ đâu ạ, chú đừng buồn nhé...hehe.
Kính chúc chú đón chào năm mới sức khỏe dồi dào, công lực thâm hậu hơn ạ.
 
Nhattanktnn đã viết:
Bạn thử code này xem đúng yêu cầu chưa:
Mã: 
Option Explicit
Sub NTKTNN()
Dim sArr(), dArr(), CusName, ProCat, fDate As Long, tDate As Long, Profit As String, Bo As Boolean
Dim i As Long, J As Long, K As Long
Application.ScreenUpdating = False
With Sheets("Filter")
    CusName = Split(.Range("B1").Value, ";")
    ProCat = Split(.Range("B2").Value, ";")
    fDate = .Range("D1").Value
    tDate = .Range("D2").Value
    Profit = .Range("E2").Value
End With
With Sheets("Orders")
    sArr = .Range("A1:J" & .Cells(.Rows.Count, "A").End(xlUp).Rows).Value
    ReDim dArr(1 To UBound(sArr), 1 To UBound(sArr, 2))
    For i = 1 To UBound(sArr, 1)
        If UBound(CusName) >= 0 Then
            For J = 0 To UBound(CusName)
                If InStr(1, sArr(i, 8), CusName(J), 1) > 0 Then Bo = True: Exit For
            Next
            If Bo = False Then GoTo Next_I
            Bo = False
        End If
        If UBound(ProCat) >= 0 Then
            For J = 0 To UBound(ProCat)
                If InStr(1, sArr(i, 10), ProCat(J), 1) > 0 Then Bo = True: Exit For
            Next
            If Bo = False Then GoTo Next_I
            Bo = False
        End If
        If fDate > 0 And tDate > 0 Then
            If sArr(i, 2) >= fDate And sArr(i, 2) <= tDate Then Bo = True
            If Bo = False Then GoTo Next_I
            Bo = False
        End If
        If Profit <> "" Then
            If Evaluate(sArr(i, 6) & Profit) Then Bo = True
            If Bo = False Then GoTo Next_I
        End If
        K = K + 1
        For J = 1 To UBound(sArr, 2)
            dArr(K, J) = sArr(i, J)
        Next
Next_I:
    Next
End With
Sheets("Filter").Range("A4:J10000").ClearContents
Sheets("Filter").Range("A4").Resize(UBound(sArr), UBound(sArr, 2)) = dArr
Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Ngoài vấn đề OT đã đề cập tại bài 46:
www.giaiphapexcel.com

Lọc dữ liệu-chứa nhiều điều kiện lọc?

Em không biết, máy em chạy bình thường mà, chỉ có 4 dòng thôi. File bài 96. @NHN_Phương lỗi này do MS quy định thế. Bạn đọc thêm https://docs.microsoft.com/en-us/office/client-developer/access/desktop-database-reference/filter-property-ado, nếu có nhiều điều kiện lọc thì làm kiểu này rất dài...
www.giaiphapexcel.com www.giaiphapexcel.com

1609511275170.png

OT thử thêm với điều kiện lọc như ảnh kèm bên trên.
B2= "Office" thì code trả về cột J có những kết quả không chứa "Office",...
Chúc bạn năm mới sức khỏe và thành công ạ.
Bài đã được tự động gộp:

ptm0412 đã viết:
Rất tiếc là tôi trích dẫn và trả lời bài của @phuongvq123 theo yêu cầu to hơn, nên chả buồn làm gì
Nhấp chuột vào đây để mở rộng...
Chú Mỹ nếu có hứng thú thì sử dụng VBA đua tốc độ đi chú, code của chú con đọc dễ hiểu ạ vì code của chú nhiều biến (tham số) :xmasbiggrin:
 
Lần chỉnh sửa cuối:
ptm0412 đã viết:
Kết hợp 2 yêu cầu ở trên, các điều kiện lọc Customer name và Category nằm ở 2 bảng, Oder date from, date to, Profit Compare mode, Profit mỗi thông số nằm ở 1 ô như hình sau, thì Power query đơn giản lắm.

View attachment 252299

- Bỏ trống Customer name hoặc Category là lấy hết theo điều kiện from - to và điều kiện Profit
- Bỏ trống Profit Compare mode cũng lấy hết theo các điều kiện khác

PHP: 
let
    DFrom=Excel.CurrentWorkbook(){[Name="DateCondition"]}[Content]{0}[Column1],
    DTo=Excel.CurrentWorkbook(){[Name="DateCondition"]}[Content]{1}[Column1],
    CompareMode=Excel.CurrentWorkbook(){[Name="ProfitCondition"]}[Content]{0}[Column1],
    ComparedProfit=Excel.CurrentWorkbook(){[Name="ProfitCondition"]}[Content]{0}[Column2],
    Source = Excel.CurrentWorkbook(){[Name="Table3"]}[Content],
    MergedCustomer = Table.NestedJoin(Source, {"Customer Name"}, CusName, {"Customer Name"}, "CusName",
        if List.NonNullCount(CusName[Customer Name]) > 0  then JoinKind.Inner else JoinKind.LeftOuter),
    MergedCategory = Table.NestedJoin(MergedCustomer, {"Product Category"}, CategoryName, {"Product Category"}, "CategoryName",
        if List.NonNullCount(CategoryName[Product Category]) > 0  then JoinKind.Inner else JoinKind.LeftOuter),
    DateFilter=Table.SelectRows(MergedCategory, each [Order Date] >= DFrom and [Order Date] <= DTo),
    ProfitFilter=Table.SelectRows(DateFilter, each
        if CompareMode = ">" then [Profit] > ComparedProfit
        else if CompareMode = ">=" then [Profit] >= ComparedProfit
        else if CompareMode = "<" then [Profit] < ComparedProfit
        else if CompareMode = "<=" then [Profit] <= ComparedProfit
        else if CompareMode = "=" then [Profit] = ComparedProfit
        else true)
in
    ProfitFilter
Nhấp chuột vào đây để mở rộng...
Code của bác hình như chưa đúng yêu cầu đề bài. Điều kiện lọc Customer name không phải tìm chính xác, không chứa họ tên đầy đủ mà chỉ là bộ phận của họ tên đó (ví dụ điều kiện lọc là "a;b" thì giá trị dạng "abc" cũng phù hợp).
Code của em làm vẽ lại bảng điều kiện. Đối với điều kiện lọc dạng Customer Name, chuyển cột của bảng điều kiện thành list, dùng vòng lặp List.Generate để xác định giá trị trong cột Customer Name có chứa một phần tử của list không. Với điều kiện Profit, dùng Evaluate cho ngắn gọn.
Mã: 
let
    Source = Excel.CurrentWorkbook(){[Name="Table3"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Order ID", Int64.Type}, {"Order Date", type date}, {"Order Quantity", Int64.Type}, {"Sales", type number}, {"Ship Mode", type text}, {"Profit", type number}, {"Unit Price", type number}, {"Customer Name", type text}, {"Customer Segment", type text}, {"Product Category", type text}}),
    lstCustomerName=Text.Split(TableFilter[Customer Name]{0},";"),
    lstProductCat=Text.Split(TableFilter[Product Category]{0},";"),
    CheckCondition = (txt as text, lst as list) =>
        if lst{0}="*" then true else
            let
                lst1=List.Generate(()=> 0, each if _=List.Count(lst) then false else not Text.Contains(txt, lst{_}), each _ +1),
                kq=List.Count(lst1)<List.Count(lst)
            in
                kq,
    kq = Table.SelectRows(#"Changed Type",each CheckCondition([Customer Name], lstCustomerName) and CheckCondition([Product Category], lstProductCat) and [Order Date]>=TableFilter[from Order Date]{0} and [Order Date]<=TableFilter[to Order Date]{0} and Expression.Evaluate((if [Profit] is null then "0" else Number.ToText([Profit])) & TableFilter[Profit1]{0} & TableFilter[Profit2]{0}))
in
    kq
Mã: 
let
    Source = Excel.CurrentWorkbook(){[Name="Table4"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Customer Name", type text}, {"Product Category", type text}, {"from Order Date", type date}, {"to Order Date", type date}, {"Profit1", type text}, {"Profit2", type text}})
in
    #"Changed Type"
 

File đính kèm

Lần chỉnh sửa cuối:
Hau151978 đã viết:
Code của bác hình như chưa đúng yêu cầu đề bài. Điều kiện lọc Customer name không phải tìm chính xác, không chứa họ tên đầy đủ mà chỉ là bộ phận của họ tên đó (ví dụ điều kiện lọc là "a;b" thì giá trị dạng "abc" cũng phù hợp).
Nhấp chuột vào đây để mở rộng...
Tôi đã ghi chú rõ rằng "các điều kiện lọc Customer name và Category nằm ở 2 bảng" vì tôi thích dữ liệu dạng chuẩn, chứ không thích kiểu không chuẩn rồi hành xác. Ngoài ra, trong danh mục khách hàng có tình trạng như dưới đây:

1609519956587.png
Chuyện gì sẽ xảy ra khi người dùng cần lọc Alan Barnes và Christine Abelman và gõ điều kiện tìm kiếm "Alan;ristin"? Tôi không ủng hộ cách tìm kiếm như vậy nên không làm đúng yêu cầu.
Chuyện thứ hai là người dùng chẳng nhớ 1 mẩu tên nào hoặc nhớ sai, rồi ra kết quả không đúng mong muốn. Lúc đó có khi lại đổ thừa tại code không chừng
 
NHN_Phương đã viết:
@Nhattanktnn , code bài 30 sau khi OT bỏ trống B2 thì lấy thêm 2 dòng dữ liệu màu đỏ, nhờ bạn xem giúp ạ.
Hoặc trong trường hợp B1 không nhập gì thì code bị lỗi "Type mismatch" tại dòng: If Evaluate(sArr(i, 6) & Profit) Then
Nhấp chuột vào đây để mở rộng...
NHN_Phương đã viết:
OT thử thêm với điều kiện lọc như ảnh kèm bên trên.
B2= "Office" thì code trả về cột J có những kết quả không chứa "Office",...
Nhấp chuột vào đây để mở rộng...
Thực chất do mình sơ ý chỗ if profit <>"" ở gần cuối vòng lặp i quên đưa bo=false vào, khi nó sang vòng mới một số trường hợp nó sẽ cho bo=true dẫn đến code sai, bạn thêm bo=false tương tự như các dòng trên
Hoặc xem code này mình có điều chỉnh chút ít theo ý bác HieuCD cho gọn
Mã: 
Option Explicit
Sub NTKTNN()
Dim sArr(), dArr(), CusName, ProCat, fDate As Long, tDate As Long, Profit As String, Bo As Boolean
Dim i As Long, J As Long, K As Long
Application.ScreenUpdating = False
With Sheets("Filter")
    CusName = Split(";" & .Range("B1").Value, ";")
    ProCat = Split(";" & .Range("B2").Value, ";")
    fDate = .Range("D1").Value
    tDate = .Range("D2").Value
    Profit = .Range("E2").Value
End With
With Sheets("Orders")
    sArr = .Range("A2:J" & .Cells(.Rows.Count, "A").End(xlUp).Rows).Value
    ReDim dArr(1 To UBound(sArr), 1 To UBound(sArr, 2))
    For i = 1 To UBound(sArr, 1)
        For J = 1 To UBound(CusName)
            If InStr(1, sArr(i, 8), CusName(J), 1) > 0 Then Bo = True: Exit For
        Next
        If Bo = False Then GoTo Next_I Else Bo = False
        For J = 0 To UBound(ProCat)
            If InStr(1, sArr(i, 10), ProCat(J), 1) > 0 Then Bo = True: Exit For
        Next
        If Bo = False Then GoTo Next_I Else Bo = False
        If fDate > 0 And tDate > 0 Then
            If sArr(i, 2) >= fDate And sArr(i, 2) <= tDate Then Bo = True
            If Bo = False Then GoTo Next_I Else Bo = False
        End If
        If Profit <> "" Then
            If Evaluate(sArr(i, 6) & Profit) Then Bo = True
            If Bo = False Then GoTo Next_I Else Bo = False
        End If
        K = K + 1
        For J = 1 To UBound(sArr, 2)
            dArr(K, J) = sArr(i, J)
        Next
Next_I:
    Next
End With
Sheets("Filter").Range("A4:J10000").ClearContents
Sheets("Filter").Range("A4").Resize(UBound(sArr), UBound(sArr, 2)) = dArr
Application.ScreenUpdating = True
End Sub
Bạn xem có vấn đề gì phản hồi lại nhé
 
Nhattanktnn đã viết:
Mã: 
Option Explicit
Sheets("Filter").Range("A4").Resize(UBound(sArr), UBound(sArr, 2)) = dArr
Bạn xem có vấn đề gì phản hồi lại nhé
Nhấp chuột vào đây để mở rộng...
Sao dArr hầu như luôn luôn < sArr mà lại gán kết quả bằng với kích thước của sArr vậy? thường với kiểu điều kiện lọc này (kiểu kỳ cục) thì chỉ có 3-4 customer, biến k chỉ có giá trị một vài chục mà gán chi tới 1 ngàn. Kết quả không sai nhưng đọc code thấy sao sao ấy.
Ngoài ra chưa bắt trường hợp k = 0. Nếu k = 0 thì chả có kết quả gì nhưng cũng gán nguyên cái mảng trắng to đùng xuống
 
ptm0412 đã viết:
Sao dArr hầu như luôn luôn < sArr mà lại gán kết quả bằng với kích thước của sArr vậy? thường với kiểu điều kiện lọc này (kiểu kỳ cục) thì chỉ có 3-4 customer, biến k chỉ có giá trị một vài chục mà gán chi tới 1 ngàn. Kết quả không sai nhưng đọc code thấy sao sao ấy.
Ngoài ra chưa bắt trường hợp k = 0. Nếu k = 0 thì chả có kết quả gì nhưng cũng gán nguyên cái mảng trắng to đùng xuống
Nhấp chuột vào đây để mở rộng...
Cảm ơn thầy đã góp ý, lúc viết xong và gửi lên đây rồi sau đó có lúc em nghĩ tới cái này, xong gửi rồi không sửa, lần sau gửi lại thì chỉ để ý tới lỗi bạn ấy nói thôi. resize(k+1,UBound(sArr, 2)) là đủ rồi mà em thích bự quá thầy nhỉ :D
 
NHN_Phương đã viết:
Chú Mỹ nếu có hứng thú thì sử dụng VBA đua tốc độ đi chú, code của chú con đọc dễ hiểu ạ vì code của chú nhiều biến (tham số) :xmasbiggrin:
Nhấp chuột vào đây để mở rộng...
Như đã viết trong bài #52, tôi không thích kiểu đặt điều kiện lọc như vậy nên không hứng thú với việc "hành xác" viết code. Ngoài ra tốc độ đối với tôi chỉ có ý nghĩa khi giảm từ 10 giây xuống 1 giây, nếu chỉ giảm từ 1 giây còn 0.8 giây hay 0.5 giây thì là làm vì đam mê. Chưa bao giờ làm vì đua.

Nếu bạn có xem chủ đề "thi code nhanh nhất 65 ngàn dòng" thì trong đó tôi viết vì khác giải thuật với mọi người. Chủ đề đó không cho sửa dữ liệu, nên khi tôi mở chủ đề 1 triệu dòng tôi đã thiết kế lại dữ liệu để code nhanh hơn nữa.

Thứ hai: Nhiều biến không phải để cho dễ đọc, mà vì nó cần thiết. Cái dễ đọc dễ hiểu ở chỗ:
- Tư duy đơn giản
- Thuật toán dễ hiểu
- Thủ thuật đơn giản
- Tên biến đặt dễ hiểu
- Và vài thứ khác
 
Lần chỉnh sửa cuối:
Nhattanktnn đã viết:
Thực chất do mình sơ ý chỗ if profit <>"" ở gần cuối vòng lặp i quên đưa bo=false vào, khi nó sang vòng mới một số trường hợp nó sẽ cho bo=true dẫn đến code sai, bạn thêm bo=false tương tự như các dòng trên
Hoặc xem code này mình có điều chỉnh chút ít theo ý bác HieuCD cho gọn
Mã: 
Option Explicit
Sub NTKTNN()
Dim sArr(), dArr(), CusName, ProCat, fDate As Long, tDate As Long, Profit As String, Bo As Boolean
Dim i As Long, J As Long, K As Long
Application.ScreenUpdating = False
With Sheets("Filter")
    CusName = Split(";" & .Range("B1").Value, ";")
    ProCat = Split(";" & .Range("B2").Value, ";")
    fDate = .Range("D1").Value
    tDate = .Range("D2").Value
    Profit = .Range("E2").Value
End With
With Sheets("Orders")
    sArr = .Range("A2:J" & .Cells(.Rows.Count, "A").End(xlUp).Rows).Value
    ReDim dArr(1 To UBound(sArr), 1 To UBound(sArr, 2))
    For i = 1 To UBound(sArr, 1)
        For J = 1 To UBound(CusName)
            If InStr(1, sArr(i, 8), CusName(J), 1) > 0 Then Bo = True: Exit For
        Next
        If Bo = False Then GoTo Next_I Else Bo = False
        For J = 0 To UBound(ProCat)
            If InStr(1, sArr(i, 10), ProCat(J), 1) > 0 Then Bo = True: Exit For
        Next
        If Bo = False Then GoTo Next_I Else Bo = False
        If fDate > 0 And tDate > 0 Then
            If sArr(i, 2) >= fDate And sArr(i, 2) <= tDate Then Bo = True
            If Bo = False Then GoTo Next_I Else Bo = False
        End If
        If Profit <> "" Then
            If Evaluate(sArr(i, 6) & Profit) Then Bo = True
            If Bo = False Then GoTo Next_I Else Bo = False
        End If
        K = K + 1
        For J = 1 To UBound(sArr, 2)
            dArr(K, J) = sArr(i, J)
        Next
Next_I:
    Next
End With
Sheets("Filter").Range("A4:J10000").ClearContents
Sheets("Filter").Range("A4").Resize(UBound(sArr), UBound(sArr, 2)) = dArr
Application.ScreenUpdating = True
End Sub
Bạn xem có vấn đề gì phản hồi lại nhé
Nhấp chuột vào đây để mở rộng...
Bạn ơi vẫn như bài 50 ạ:
Nếu B1 không nhập gì và B2= "Office" thì code trả về cột J có những kết quả không chứa "Office",...
Bài đã được tự động gộp:

ptm0412 đã viết:
Tôi đã ghi chú rõ rằng "các điều kiện lọc Customer name và Category nằm ở 2 bảng" vì tôi thích dữ liệu dạng chuẩn, chứ không thích kiểu không chuẩn rồi hành xác. Ngoài ra, trong danh mục khách hàng có tình trạng như dưới đây:

View attachment 252312
Chuyện gì sẽ xảy ra khi người dùng cần lọc Alan Barnes và Christine Abelman và gõ điều kiện tìm kiếm "Alan;ristin"? Tôi không ủng hộ cách tìm kiếm như vậy nên không làm đúng yêu cầu.
Chuyện thứ hai là người dùng chẳng nhớ 1 mẩu tên nào hoặc nhớ sai, rồi ra kết quả không đúng mong muốn. Lúc đó có khi lại đổ thừa tại code không chừng
Nhấp chuột vào đây để mở rộng...
Con thấy có chuyện gì sảy ra đâu chú Mỹ, con đang sử dụng ADO bài 45 ạ.

1609560209358.png
 
Lần chỉnh sửa cuối:
NHN_Phương đã viết:
Con thấy có chuyện gì sảy ra đâu chú Mỹ, con đang sử dụng ADO bài 45 ạ.
Nhấp chuột vào đây để mở rộng...
Đọc thật kỹ nhé: "cần tìm Alan Barnes và Christine Abelman", kết quả tình cờ khớp Barnes, nhưng ra thêm Alan Shoneley và ristin lại ra Kargatis.
Còn mục 2: Khi người dùng không nhớ 1 mẩu tên nào, hoặc gõ sai điều kiện tìm kiếm. Đừng nói là file chỉ 1 mình mình xài, và mình nhớ hết 400 cái tên.
 
Lần chỉnh sửa cuối:
NHN_Phương đã viết:
Bạn ơi vẫn như bài 50 ạ:
Nếu B1 không nhập gì và B2= "Office" thì code trả về cột J có những kết quả không chứa "Office",...
Bài đã được tự động gộp:


Con thấy có chuyện gì sảy ra đâu chú Mỹ, con đang sử dụng ADO bài 45 ạ.

View attachment 252327
Nhấp chuột vào đây để mở rộng...
Bạn sửa lại đoạn sau nha (J=1 thay vì 0 quên lui quên tới :( )
1609561651867.png

Sửa thêm chỗ này nữa nhé bạn
1609566161056.png
 
Lần chỉnh sửa cuối:
Nhattanktnn đã viết:
resize(k+1,UBound(sArr, 2)) là đủ rồi
Nhấp chuột vào đây để mở rộng...
Sẽ có khi dư, khi mà tất cả các dòng dữ liệu đều thoả. Thí dụ bỏ trống customer name, bỏ trống category, date from = 1/1/1950, date to = 31/12/2021, Profit > 1 tỷ. Dư 1 dòng và dòng đó lỗi VALUES
 
ptm0412 đã viết:
Sẽ có khi dư, khi mà tất cả các dòng dữ liệu đều thoả. Thí dụ bỏ trống customer name, bỏ trống category, date from = 1/1/1950, date to = 31/12/2021, Profit > 1 tỷ. Dư 1 dòng và dòng đó lỗi VALUES
Nhấp chuột vào đây để mở rộng...
Cái này hình như chưa đúng lắm thầy ạ (bỏ qua vấn đề code em còn đang lỗi ở một số ô profit="" không so sánh được nhé). Nếu theo code, tất cả đều thỏa là cứ bỏ trống toàn bộ. Vậy khi resize tăng thêm 1 dòng để gán darr thì dòng cuối là dòng trống chứ sao lại báo lỗi value thầy? ví dụ như darr=1000 dòng 10 cột, mình resize(1001,10) =darr vẫn được mà thầy
 
Nhattanktnn đã viết:
Vậy khi resize tăng thêm 1 dòng để gán darr thì dòng cuối là dòng trống chứ sao lại báo lỗi value thầy? ví dụ như darr=1000 dòng 10 cột, mình resize(1001,10) =darr vẫn được mà thầy
Nhấp chuột vào đây để mở rộng...
Nói thì không chịu tin. Tôi nhớ nhầm, lỗi NA chứ không phải lỗi VALUE

1609567004922.png
 
Nhattanktnn đã viết:
Vậy thầy kiểm tra lại giúp em, sao code em để k+1 vậy (điều kiện trên để trống hết), dữ liệu trả về đủ cả mà dòng cuối cùng không bị #N/A vậy ạ? Trường hợp này có đặc biệt gì không thầy
Nhấp chuột vào đây để mở rộng...
Sau khi thoát vòng lặp thì k chứa số dòng dữ liệu, nếu k=ubound(sarr) thì vùng k+1 sẽ lớn hơn số dòng của mảng dẫn đến lỗi. Cách khắc phục là bạn không nên tìm cách thu gọn code lại dẫn tới khó hiểu, dễ sai, cứ xét if k>0 then resize(k) là được.
 
Nhattanktnn đã viết:
Vậy thầy kiểm tra lại giúp em, sao code em để k+1 vậy (điều kiện trên để trống hết), dữ liệu trả về đủ cả mà dòng cuối cùng không bị #N/A vậy ạ? Trường hợp này có đặc biệt gì không thầy
Nhấp chuột vào đây để mở rộng...
Do bạn lấy dữ liệu sArr luôn cả tiêu đề nên số dòng của sArr nhiều hơn dữ liệu 1 dòng. Sau đó dArr lại Redim bằng với sArr
PHP: 
With Sheets("Orders")
    sArr = .Range("A1:J" & .Cells(.Rows.Count, "A").End(xlUp).Rows).Value
    ReDim dArr(1 To UBound(sArr), 1 To UBound(sArr, 2))
 
ptm0412 đã viết:
Do bạn lấy dữ liệu sArr luôn cả tiêu đề nên số dòng của sArr nhiều hơn dữ liệu 1 dòng. Sau đó dArr lại Redim bằng với sArr
PHP: 
With Sheets("Orders")
    sArr = .Range("A1:J" & .Cells(.Rows.Count, "A").End(xlUp).Rows).Value
    ReDim dArr(1 To UBound(sArr), 1 To UBound(sArr, 2))
Nhấp chuột vào đây để mở rộng...
Lúc nãy em hỏi là em đã kiểm tra theo code bài #53 thầy ạ, còn từ A1 thì K+1 là vừa đủ thì em biết. Nhưng cuối cùng kiểm tra kỹ lại nó là ở chỗ này (nhiều khi nhanh nhẩu quá khổ):
Rich (BB code): 
sArr = .Range("A1:J" & .Cells(.Rows.Count, "A").End(xlUp).Rows).Value
Gửi lại bạn @NHN_Phương code cuối cùng của mình nhé : (mà mình thấy bạn cũng học code, cũng biết nhiều lắm mà, tự sửa nếu chưa ưng ý nhé)
Mã: 
Option Explicit
Sub NTKTNN()
Dim sArr(), dArr(), CusName, ProCat, fDate As Long, tDate As Long, Profit As String, Bo As Boolean
Dim i As Long, J As Long, K As Long
Application.ScreenUpdating = False
With Sheets("Orders")
    sArr = .Range("A2:J" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
End With
With Sheets("Filter")
    CusName = Split(";" & .Range("B1").Value, ";")
    ProCat = Split(";" & .Range("B2").Value, ";")
    fDate = .Range("D1").Value
    tDate = .Range("D2").Value
    Profit = .Range("E2").Value
    ReDim dArr(1 To UBound(sArr), 1 To UBound(sArr, 2))
    For i = 1 To UBound(sArr, 1)
        For J = 1 To UBound(CusName)
            If InStr(1, sArr(i, 8), CusName(J), 1) > 0 Then Bo = True: Exit For
        Next
        If Bo = False Then GoTo Next_I Else Bo = False
        For J = 1 To UBound(ProCat)
            If InStr(1, sArr(i, 10), ProCat(J), 1) > 0 Then Bo = True: Exit For
        Next
        If Bo = False Then GoTo Next_I Else Bo = False
        If fDate > 0 And tDate > 0 Then
            If sArr(i, 2) >= fDate And sArr(i, 2) <= tDate Then Bo = True
            If Bo = False Then GoTo Next_I Else Bo = False
        End If
        If Profit <> "" Then
            If Evaluate(sArr(i, 6) * 1 & Profit) Then Bo = True
            If Bo = False Then GoTo Next_I Else Bo = False
        End If
        K = K + 1
        For J = 1 To UBound(sArr, 2)
            dArr(K, J) = sArr(i, J)
        Next
Next_I:
    Next
    If K Then
        .Range("A4:J10000").ClearContents
        .Range("A4").Resize(K, UBound(sArr, 2)) = dArr
    End If
End With
Application.ScreenUpdating = True
End Sub
 
Nhattanktnn đã viết:
Lúc nãy em hỏi là em đã kiểm tra theo code bài #53 thầy ạ, còn từ A1 thì K+1 là vừa đủ thì em biết. Nhưng cuối cùng kiểm tra kỹ lại nó là ở chỗ này (nhiều khi nhanh nhẩu quá khổ):
Rich (BB code): 
sArr = .Range("A1:J" & .Cells(.Rows.Count, "A").End(xlUp).Rows).Value
Nhấp chuột vào đây để mở rộng...
Kể cả .Row (không s) nhưng lấy từ A1:J mà làm sao không dư
 
NHN_Phương đã viết:
Con chào Bác @HieuCD ,
Cảm ơn Bác đã quan tâm vấn đề của con ạ.
Bác mà tham gia, nhờ Bác xử lý giúp con thêm 2 điều kiện nữa lọc trong ô D1,D2,E2 theo cột "Order Date" & "Profit" với ạ:
Bắt lỗi điều kiện nếu có điều kiện trong ô D1 & D2 thì phải đủ cả 2 điều kiện từ ngày đến ngày và ngày trong ô D2 lớn hơn ngày trong ô D1thì mới code mới chạy ạ .

View attachment 252181
Nhấp chuột vào đây để mở rộng...
ô E2 giá trị Profit format cell là "Text"
Chạy thử code
Mã: 
Sub XYZ()
  Dim sArr(), Res()
  Dim i&, n&, k&, j&, sRow&, sCol&
  Dim Customer, Product, fDate, eDate, Profit, tmp
 
  With Sheets("Orders")
    sArr = .Range("A2:J" & .Range("H" & Rows.Count).End(xlUp).Row).Value
  End With
  sRow = UBound(sArr): sCol = UBound(sArr, 2)
  ReDim Res(1 To sRow, 1 To 10)
  With Sheets("Filter")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i > 3 Then .Range("A4:J" & i).ClearContents 'Xoa du lieu
   
    Customer = Split(";" & .Range("B1").Value, ";")
    If Customer(1) = "*" Then Customer(1) = ""
   
    Product = Split(";" & .Range("B2").Value, ";")
    If Product(1) = "*" Then Product(1) = ""
   
    fDate = .Range("D1").Value:    eDate = .Range("D2").Value
    If Not (IsDate(fDate) And IsDate(eDate)) Or fDate > eDate Then
      MsgBox ("Nhap lai dieu kien ngay thang"): Exit Sub
    End If
   
    Profit = .Range("E2").Value
    If IsNumeric(Profit) And Profit <> Empty Then Profit = "=" & Profit
  End With
  For i = 1 To sRow
    tmp = sArr(i, 8)
    For n = 1 To UBound(Customer)
      If InStr(1, tmp, Customer(n), vbTextCompare) > 0 Then Exit For
    Next n
    If n = UBound(Customer) + 1 Then GoTo KhongThoaDieuKien
   
    tmp = sArr(i, 10)
    For n = 1 To UBound(Product)
      If InStr(1, tmp, Product(n), vbTextCompare) > 0 Then Exit For
    Next n
    If n = UBound(Product) + 1 Then GoTo KhongThoaDieuKien
   
    If sArr(i, 2) < fDate Or sArr(i, 2) > eDate Then GoTo KhongThoaDieuKien
   
    If Evaluate(Val(sArr(i, 6)) & Profit) Or Profit = Empty Then
      k = k + 1
      For j = 1 To 10
        Res(k, j) = sArr(i, j)
      Next j
    End If
KhongThoaDieuKien:
  Next i
  If k Then Sheets("Filter").Range("A4:J4").Resize(k).Value = Res
End Sub
 

File đính kèm

NHN_Phương đã viết:
Cảm ơn Bạn @Hau151978 nhiều ạ, kết quả đúng ý OT rồi ạ. Sử dụng câu lệnh truy vấn luôn ngắn gọn và cho kết chính xác thật.
@Nhattanktnn , code bài 30 sau khi OT bỏ trống B2 thì lấy thêm 2 dòng dữ liệu màu đỏ, nhờ bạn xem giúp ạ.
Hoặc trong trường hợp B1 không nhập gì thì code bị lỗi "Type mismatch" tại dòng: If Evaluate(sArr(i, 6) & Profit) Then

View attachment 252292
Nhấp chuột vào đây để mở rộng...
Điều kiện B1 và B2 là chuỗi đầy đủ hay là sao em?
 
Nhattanktnn đã viết:
Lúc nãy em hỏi là em đã kiểm tra theo code bài #53 thầy ạ, còn từ A1 thì K+1 là vừa đủ thì em biết. Nhưng cuối cùng kiểm tra kỹ lại nó là ở chỗ này (nhiều khi nhanh nhẩu quá khổ):
Rich (BB code): 
sArr = .Range("A1:J" & .Cells(.Rows.Count, "A").End(xlUp).Rows).Value
Gửi lại bạn @NHN_Phương code cuối cùng của mình nhé : (mà mình thấy bạn cũng học code, cũng biết nhiều lắm mà, tự sửa nếu chưa ưng ý nhé)
Mã: 
Option Explicit
Sub NTKTNN()
Dim sArr(), dArr(), CusName, ProCat, fDate As Long, tDate As Long, Profit As String, Bo As Boolean
Dim i As Long, J As Long, K As Long
Application.ScreenUpdating = False
With Sheets("Orders")
    sArr = .Range("A2:J" & .Cells(.Rows.Count, "A").End(xlUp).Row).Value
End With
With Sheets("Filter")
    CusName = Split(";" & .Range("B1").Value, ";")
    ProCat = Split(";" & .Range("B2").Value, ";")
    fDate = .Range("D1").Value
    tDate = .Range("D2").Value
    Profit = .Range("E2").Value
    ReDim dArr(1 To UBound(sArr), 1 To UBound(sArr, 2))
    For i = 1 To UBound(sArr, 1)
        For J = 1 To UBound(CusName)
            If InStr(1, sArr(i, 8), CusName(J), 1) > 0 Then Bo = True: Exit For
        Next
        If Bo = False Then GoTo Next_I Else Bo = False
        For J = 1 To UBound(ProCat)
            If InStr(1, sArr(i, 10), ProCat(J), 1) > 0 Then Bo = True: Exit For
        Next
        If Bo = False Then GoTo Next_I Else Bo = False
        If fDate > 0 And tDate > 0 Then
            If sArr(i, 2) >= fDate And sArr(i, 2) <= tDate Then Bo = True
            If Bo = False Then GoTo Next_I Else Bo = False
        End If
        If Profit <> "" Then
            If Evaluate(sArr(i, 6) * 1 & Profit) Then Bo = True
            If Bo = False Then GoTo Next_I Else Bo = False
        End If
        K = K + 1
        For J = 1 To UBound(sArr, 2)
            dArr(K, J) = sArr(i, J)
        Next
Next_I:
    Next
    If K Then
        .Range("A4:J10000").ClearContents
        .Range("A4").Resize(K, UBound(sArr, 2)) = dArr
    End If
End With
Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
HieuCD đã viết:
ô E2 giá trị Profit format cell là "Text"
Chạy thử code
Mã: 
Sub XYZ()
  Dim sArr(), Res()
  Dim i&, n&, k&, j&, sRow&, sCol&
  Dim Customer, Product, fDate, eDate, Profit, tmp

  With Sheets("Orders")
    sArr = .Range("A2:J" & .Range("H" & Rows.Count).End(xlUp).Row).Value
  End With
  sRow = UBound(sArr): sCol = UBound(sArr, 2)
  ReDim Res(1 To sRow, 1 To 10)
  With Sheets("Filter")
    i = .Range("A" & Rows.Count).End(xlUp).Row
    If i > 3 Then .Range("A4:J" & i).ClearContents 'Xoa du lieu
  
    Customer = Split(";" & .Range("B1").Value, ";")
    If Customer(1) = "*" Then Customer(1) = ""
  
    Product = Split(";" & .Range("B2").Value, ";")
    If Product(1) = "*" Then Product(1) = ""
  
    fDate = .Range("D1").Value:    eDate = .Range("D2").Value
    If Not (IsDate(fDate) And IsDate(eDate)) Or fDate > eDate Then
      MsgBox ("Nhap lai dieu kien ngay thang"): Exit Sub
    End If
  
    Profit = .Range("E2").Value
    If IsNumeric(Profit) And Profit <> Empty Then Profit = "=" & Profit
  End With
  For i = 1 To sRow
    tmp = sArr(i, 8)
    For n = 1 To UBound(Customer)
      If InStr(1, tmp, Customer(n), vbTextCompare) > 0 Then Exit For
    Next n
    If n = UBound(Customer) + 1 Then GoTo KhongThoaDieuKien
  
    tmp = sArr(i, 10)
    For n = 1 To UBound(Product)
      If InStr(1, tmp, Product(n), vbTextCompare) > 0 Then Exit For
    Next n
    If n = UBound(Product) + 1 Then GoTo KhongThoaDieuKien
  
    If sArr(i, 2) < fDate Or sArr(i, 2) > eDate Then GoTo KhongThoaDieuKien
  
    If Evaluate(Val(sArr(i, 6)) & Profit) Or Profit = Empty Then
      k = k + 1
      For j = 1 To 10
        Res(k, j) = sArr(i, j)
      Next j
    End If
KhongThoaDieuKien:
  Next i
  If k Then Sheets("Filter").Range("A4:J4").Resize(k).Value = Res
End Sub
Nhấp chuột vào đây để mở rộng...
Xin cảm ơn Bác @HieuCD và Bạn @Nhattanktnn đã luôn quan tâm & giúp đỡ OT, cả 2 code chạy khá nhanh ra kết quả chính xác rồi ạ.

Hai Lúa Miền Tây đã viết:
Điều kiện B1 và B2 là chuỗi đầy đủ hay là sao em?
Nhấp chuột vào đây để mở rộng...

Xin chào anh @Hai Lúa Miền Tây ,
Cảm ơn anh đã quan tâm đến vấn đề của OT ạ.
Dạ B1 và B2 có thể là chuỗi đầy đủ và cũng có thể là chuỗi không đầy đủ anh ạ, hihi.
Kính chúc anh năm mới sức khỏe & thành công ạ.
 
NHN_Phương đã viết:
Dạ vầng đúng rồi anh: PQ,VBA,ADO đều đủ cả rồi anh ạ. :heart:
Nếu anh Hai Lúa có thêm cách gì độc đáo & và có hứng thì ... tiếp tục đi anh. :fish:
Nhấp chuột vào đây để mở rộng...
Nạp hết vào Recordset rồi lọc dữ liệu. Tuy nhiên nếu lọc 1 lần trên dữ liệu thì em có thể dùng kết quả những bài trên. Còn nếu cứ dùng Recordset đó để lọc nhiều lần thì nên dùng cách anh đề nghị.
 
Hai Lúa Miền Tây đã viết:
Nạp hết vào Recordset rồi lọc dữ liệu. Tuy nhiên nếu lọc 1 lần trên dữ liệu thì em có thể dùng kết quả những bài trên. Còn nếu cứ dùng Recordset đó để lọc nhiều lần thì nên dùng cách anh đề nghị.
Nhấp chuột vào đây để mở rộng...
Hic anh Hai Lúa nói vậy OT tiếp thu không khác gì đàn gảy tai trâu anh ơi.
"Còn nếu cứ dùng Recordset đó để lọc nhiều lần thì nên dùng cách anh đề nghị." nếu có hứng thú anh chỉ dẫn thêm cách này nhé anh. :"'
 
Hai Lúa Miền Tây đã viết:
Nạp nó tương tự bài Khai thác và tùy biến thêm, sửa, xuất file và lấy dữ liệu từ Recordset đó em.
Nhấp chuột vào đây để mở rộng...

Hehe sau một hồi loay hoay OT làm theo gợi ý của anh Hai Lúa, dùng Recordset để lọc thì có thấy hơi khác một chút với Connection của bài Bạn @Hau151978 :

Recordset like sử dụng "*" còn Connection sử dụng "%"
Recordset không sử dụng where giống với Connection
Do đo OT cũng sửa lại chút hàm ConvertCriteria để tùy biến theo 2 phương pháp và kết hợp một thêm phần code của bác @HieuCD
OT cảm giác như dùng Recordset nhanh hơn Connection thì phải, toàn bộ code như sau , nhờ anh @Hai Lúa Miền Tây và mọi người góp ý ạ:
Mã: 
Public Function ConvertCriteria(Field As String, Criteria As String, sLike As String) As String
    If Criteria = "*" Then
        ConvertCriteria = "TRUE"
    Else
        ConvertCriteria = "([" & Field & "] LIKE " & sLike & _
            Replace(Criteria, ";", sLike & " OR [" & Field & "] LIKE " & sLike) & sLike & ")"
    End If
End Function

Sub Filter_Rst()
    
    Dim Rst As New ADODB.Recordset, sCn As String, SrtSQL As String
    Dim wb As Workbook, shtFilter As Worksheet, sLike As String, Lr As Long
    Dim Customer As String, Product As String, Profit As String, fDate As Date, eDate As Date
    
    Const sDULIEU  As String = "Select * from [Orders$]"
    
    On Error GoTo ErrorProcess
    
    Set wb = ThisWorkbook
    Set shtFilter = wb.Worksheets("Filter")
    
    With shtFilter
        Lr = .Range("A" & Rows.Count).End(xlUp).Row
        If Lr > 3 Then .Range("A4:J" & Lr).ClearContents
        Customer = .Range("B1"):    Product = .Range("B2")
        fDate = .Range("D1"):       eDate = .Range("D2")
        Profit = .Range("E2")
    End With
    
    sLike = "*"
    SrtSQL = ConvertCriteria("Customer Name", Customer, sLike)
    SrtSQL = SrtSQL & " AND " & ConvertCriteria("Product category", Product, sLike)
    If Not (IsDate(fDate) And IsDate(eDate)) Or fDate > eDate Then
        MsgBox "Nhap lai dieu kien ngay thang", vbCritical, "Error"
        GoTo EndSub
    Else
        If SrtSQL <> Empty Then
            SrtSQL = SrtSQL & " AND ([Order date] >=#" & fDate & "#" & " AND [Order date] <=#" & eDate & "#)"
        Else
            SrtSQL = " ([Order date] >=#" & fDate & "#" & " And [Order date] <=#" & eDate & "#)"
        End If
    End If
    If Profit <> Empty Then
        If Profit = "=0" Then
            SrtSQL = SrtSQL & " AND (Profit=0)"
        Else
            SrtSQL = SrtSQL & " AND Profit" & Profit
        End If
    End If
    
    Debug.Print SrtSQL
    
    sCn = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0 Xml;Data Source=" & wb.FullName
    With Rst
        .Open sDULIEU, sCn, 1
        .Filter = SrtSQL
        shtFilter.Range("A4").CopyFromRecordset .DataSource
    End With
  
    GoTo EndSub
    
ErrorProcess:

    If Err <> 0 Then
        MsgBox Err.Number & "/" & Err.Source & "-->" & Err.Description, vbOKOnly + vbCritical, "Error"
    End If

EndSub:
    If Not Rst Is Nothing Then
        If Rst.State = adStateOpen Then Rst.Close
    End If
    Set Rst = Nothing
 
End Sub
 
befaint đã viết:
Lão ấy không chiều chuộng, lão làm đơn giản vì lão biết là cổ thôi. :D
Nhấp chuột vào đây để mở rộng...
Biết là "cổ" mà vẫn không chiều, lại còn mắng là kiểu đặt điều kiện lọc kỳ cục. Còn làm là làm theo kiểu chuẩn không kỳ cục.
 
ptm0412 đã viết:
Biết là "cổ" mà vẫn không chiều, lại còn mắng là kiểu đặt điều kiện lọc kỳ cục. Còn làm là làm theo kiểu chuẩn không kỳ cục.
Nhấp chuột vào đây để mở rộng...
Không ổn rồi chú Mỹ xem giúp con câu lệnh bài #81 của con thế nào nếu B1 hoặc B2 có 1 điều kiện thì không sao còn từ 2 điều kiện trở lên là câu truy vấn bị lỗi. Hic -+*/
 
NHN_Phương đã viết:
Không ổn rồi chú Mỹ xem giúp con câu lệnh bài #81 của con thế nào nếu B1 hoặc B2 có 1 điều kiện thì không sao còn từ 2 điều kiện trở lên là câu truy vấn bị lỗi. Hic -+*/
Nhấp chuột vào đây để mở rộng...
Hàm ConvertCriteria có split chuỗi ra đâu mà 2 với nhiều điều kiện
 
ptm0412 đã viết:
Hàm ConvertCriteria có split chuỗi ra đâu mà 2 với nhiều điều kiện
Nhấp chuột vào đây để mở rộng...
Ủa con vận dụng y chang bài 45 của bạn @Hau151978 mà Chú, con nghĩ là có thể là có thể do cú pháp áp dụng trong Recordset với nhiều điều kiện trong một trường mà con làm sang bị sai ở đâu đó ấy ạ. Hic con tưởng ngon ăn, giờ test thử mà thấy nhiều lỗi quá chú ạ, ví dụ lỗi nếu B1 không có gì mà B2 có cũng không được.. hic
 
NHN_Phương đã viết:
Ủa con vận dụng y chang bài 45 của bạn @Hau151978 mà Chú, con nghĩ là có thể là có thể do cú pháp áp dụng trong Recordset với nhiều điều kiện trong một trường mà con làm sang bị sai ở đâu đó ấy ạ. Hic con tưởng ngon ăn, giờ test thử mà thấy nhiều lỗi quá chú ạ, ví dụ lỗi nếu B1 không có gì mà B2 có cũng không được.. hic
Nhấp chuột vào đây để mở rộng...
Cái sai chỉ nằm trong phạm vi cái hàm ConvertCriteria thôi.
- Trong đó có replace ";" nhưng không có tách chuỗi
- Trong đó chưa bắt chuỗi rỗng
 
Hau151978 đã viết:
@NHN_Phương bạn đặt breakpoint ở chỗ câu lệnh With srt, chạy code đến khi dừng để xem chuỗi strsql là gì đã.
Nhấp chuột vào đây để mở rộng...
Cảm ơn Bạn Hau151978 đã góp ý.
Mới đầu OT cũng đã kiểm tra câu lệnh truy vẫn nên trước with rst OT cũng đã đặt câu lệnh Debug.Print SrtSQL để xem nó là gì đó ạ.
Loay hoay mãi không được OT tắt máy rồi bạn ạ, hihi.
 
Tôi sai ở chỗ "chưa split chuỗi" và chưa biết nguyên nhân do máy chạy bị lỗi conflict gì đó.
Còn B1, B2 rỗng bị lỗi thì phải bắt trong hàm như tôi nói:
Mã: 
    If Criteria = "*" Or Criteria = "" Then
        ConvertCriteria = "TRUE"
 
ptm0412 đã viết:
Tôi sai ở chỗ "chưa split chuỗi" và chưa biết nguyên nhân do máy chạy bị lỗi conflict gì đó.
Còn B1, B2 rỗng bị lỗi thì phải bắt trong hàm như tôi nói:
Mã: 
    If Criteria = "*" Or Criteria = "" Then
        ConvertCriteria = "TRUE"
Nhấp chuột vào đây để mở rộng...

Bẫy lỗi trong hàm này có thể chưa ổn chú Mỹ ạ, vì ở câu lệnh:
SrtSQL = ConvertCriteria("Customer Name", Customer, sLike)
SrtSQL = SrtSQL & " AND " & ConvertCriteria("Product category", Product, sLike)
Nếu B1 rỗng thì B2 lỗi do câu lệnh dòng 2 có AND ở đầu ạ.
Hau151978 đã viết:
@NHN_Phương bạn đặt breakpoint ở chỗ câu lệnh With srt, chạy code đến khi dừng để xem chuỗi strsql là gì đã.
Nhấp chuột vào đây để mở rộng...

Xin anh @Hai Lúa Miền Tây và Bạn @Hau151978 cùng tất cả mọi người, OT thử gán SrtSQL cho câu lệnh sau thì không có lỗi:

SrtSQL = " ([Customer Name] LIKE *are* OR [Customer Name] LIKE *g*)" & _
" OR ([Product category] LIKE *O*)" & _
" OR ([Order date] >=#1/Jan/2011# And [Order date] <=#31/Dec/2011#)" & _
" OR Profit>0"
Nhấp chuột vào đây để mở rộng...

=> Nhưng kết quả sai.

Nhưng sau khi sửa lại gán SrtSQL cho câu lệnh sau :
SrtSQL = " ([Customer Name] LIKE *are* OR [Customer Name] LIKE *g*)" & _
" AND ([Product category] LIKE *O*)" & _
" AND ([Order date] >=#1/Jan/2011# And [Order date] <=#31/Dec/2011#)" & _
" AND Profit>0"
Nhấp chuột vào đây để mở rộng...

Thì code lỗi:
Err.Number: 3001
Err.Source: "ADODB.Recordset"
Err.Description: "Arguments are of the wrong type, are out of acceptable range, or are in conflict with one another."

Như vậy là sao ạ,không sử dụng được AND ạ ? Hic
 
NHN_Phương đã viết:
Bẫy lỗi trong hàm này có thể chưa ổn chú Mỹ ạ, vì ở câu lệnh:
SrtSQL = ConvertCriteria("Customer Name", Customer, sLike)
SrtSQL = SrtSQL & " AND " & ConvertCriteria("Product category", Product, sLike)
Nếu B1 rỗng thì B2 lỗi do câu lệnh dòng 2 có AND ở đầu ạ.
Mã: 
SrtSQL = " ([Customer Name] LIKE *are* OR [Customer Name] LIKE *g*)" & _
" AND ([Product category] LIKE *O*)" & _
" AND ([Order date] >=#1/Jan/2011# And [Order date] <=#31/Dec/2011#)" & _
" AND Profit>0"
Nhấp chuột vào đây để mở rộng...
Nếu B1 và/ hoặc B2 rỗng thì làm sao lỗi được, câu điều kiện lọc SQL là
- B1 rỗng, B2 không rỗng:
SrtSQ = True AND ([Product category] LIKE *O*)" AND ...

- B1 không rỗng, B2 rỗng
SrtSQ = ([Customer Name] LIKE *are* OR [Customer Name] LIKE *g*) AND True AND ...

- Cả 2 đều rỗng
SrtSQ = True AND True AND ...

Ghi chú: phải test chứ đừng tưởng tượng. Nếu tưởng tượng thì phải tưởng tượng rằng B1 = "*" không lỗi thì B1="" cũng không lỗi do cùng gán True
Có gán null đâu mà dư And.
 
ptm0412 đã viết:
Nếu B1 và/ hoặc B2 rỗng thì làm sao lỗi được, câu điều kiện lọc SQL là
- B1 rỗng, B2 không rỗng:
SrtSQ = True AND ([Product category] LIKE *O*)" AND ...
- B1 không rỗng, B2 rỗng
SrtSQ = ([Customer Name] LIKE *are* OR [Customer Name] LIKE *g*) AND True AND ...
- Cả 2 đều rỗng
SrtSQ = True AND True AND ...

Ghi chú: phải test chứ đừng tưởng tượng
Nhấp chuột vào đây để mở rộng...
Vâng đúng là con chưa test thật nên mới nghĩ là có thể, nhưng đúng là kiểu bắt lỗi này như chú Mỹ giải thích con thấy đơn giản và hiệu quả thật thay vì phải sử dụng nhiểu hàm if, cảm ơn chú Mỹ.
 
NHN_Phương đã viết:
OT thử gán SrtSQL cho câu lệnh sau thì không có lỗi:

=> Nhưng kết quả sai.

Nhưng sau khi sửa lại gán SrtSQL cho câu lệnh sau :

Thì code lỗi:
Err.Number: 3001
Err.Source: "ADODB.Recordset"
Err.Description: "Arguments are of the wrong type, are out of acceptable range, or are in conflict with one another."
Nhấp chuột vào đây để mở rộng...
Theo mình đoán thì sau chuỗi sau LIKE phải để trong cặp dấu nháy, còn tại sao lệnh trên chạy được thì không rõ, chắc do may mắn, mình chỉ đoán thôi chứ toàn gán toàn bộ recordset xuống sheet, không làm kiểu này bao giờ.
 
Hau151978 đã viết:
Theo mình đoán thì sau chuỗi sau LIKE phải để trong cặp dấu nháy, còn tại sao lệnh trên chạy được thì không rõ, chắc do may mắn, mình chỉ đoán thôi chứ toàn gán toàn bộ recordset xuống sheet, không làm kiểu này bao giờ.
Nhấp chuột vào đây để mở rộng...
Xin chào bạn @Hau151978 ,
Vâng có thể là câu lệnh ban đầu chạy được do may mắn ạ, để cho chắc ăn
sau chuỗi sau LIKE phải để trong cặp dấu nháy
Nhấp chuột vào đây để mở rộng...
trong hàm ConvertCriteria OT cũng đã thay toàn bộ "%" thành "*" rồi:
Function ConvertCriteria(Field As String, Criteria As String) As String
If Criteria = "*" Then
ConvertCriteria = "TRUE"
Else
ConvertCriteria = "([" & Field & "] LIKE ""*" & Replace(Criteria, ";", "*"" OR [" & Field & "] LIKE ""*") & "*"")"
End If
End Function
Nhấp chuột vào đây để mở rộng...
nhưng vẫn không được ạ.

Ủa như vậy là làm như thế nào vậy Bạn, Bạn chỉ dẫn thêm với ạ. OT tham khảo và làm y chang kiểu trong bài viết này của anh @Hai Lúa Miền Tây mà:
Nhấp chuột vào đây để mở rộng...
www.giaiphapexcel.com

Khai thác và tùy biến thêm, sửa, xuất file và lấy dữ liệu từ Recordset

có lẻ nên mở rộng chủ đề nghiên cứu thêm Rs.UpdateBatch ở nhiều cách tiếp cận ADODB khác nhau đi ... vì trên GPE này thấy còn quá ít cho nó
www.giaiphapexcel.com www.giaiphapexcel.com
 

File đính kèm

ptm0412 đã viết:
Sao code của @Hau151978 chạy ra cả 2 dòng của năm 2012 nhỉ?

View attachment 252371
Nhấp chuột vào đây để mở rộng...
Em không biết, máy em chạy bình thường mà, chỉ có 4 dòng thôi. File bài 96.
@NHN_Phương lỗi này do MS quy định thế. Bạn đọc thêm https://docs.microsoft.com/en-us/of...esktop-database-reference/filter-property-ado, nếu có nhiều điều kiện lọc thì làm kiểu này rất dài. Còn sau LIKE ở đây nên dùng dấu nháy đơn.
 
Lần chỉnh sửa cuối:
ptm0412 đã viết:
Quay lại xài mảng, hoặc Power query cho chắc cú, với điều kiện lọc chuẩn. Chiều chuộng hoài cho mệt ;)
Nhấp chuột vào đây để mở rộng...
Nếu dùng ADO copy toàn bộ recordset thì câu lệnh SQL cũng đơn giản mà bác, em không hiểu sao máy bác lại ra vậy, chắc chạy nhiều bị loạn. Riêng Recordset.Filter mới có quy định chặt chẽ, không như mệnh đề WHERE.
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

T
  • Question Question
Code VBA tra cứu kết quả trả về mảng dữ liệu (2 người xem)
    • Cười
Trả lời
8
Đọc
164
tiendu02
T
N
Một ví dụ về XLL add-in: Tương tác với Google Gemini dưới dạng công thức bảng tính (1 người xem)
    • Thích
Trả lời
3
Đọc
814
chitbk
C
V
Quản lý xuất nhập vật tư trong kho (1 người xem)
Trả lời
19
Đọc
724
LOGANWover
L
Gà Công Nghệ
Nhờ anh chị chuyển hộ font chữ excel
Trả lời
1
Đọc
32
huhumalu
H
phuongnam366377
Học C++ từ số 0 – Bài học đầu tiên (2 người xem)
    • Cảm ơn
Trả lời
4
Đọc
319
phuongnam366377
phuongnam366377
F
Mấy cao thủ giúp dùm mình với. File excel bị lỗi mà mình không biết lỗi chỗ nào để sửa. (2 người xem)
Trả lời
2
Đọc
86
firstbood
F
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
3 4 5
Trả lời
438
Đọc
58K
sát thủ uyên ương
S
X
Làm thế nào để ẩn "Blank" trong Pivot table
    • Thích
Trả lời
15
Đọc
36K
nguyenngochieu761321
nguyenngochieu761321
H
Đánh số thự theo lượt (1 người xem)
Trả lời
5
Đọc
135
hongminh_0306
H
D
XIN PHẦN MỀM XẾP TKB TIỂU HỌC BẰNG EXCEL (1 người xem)
Trả lời
2
Đọc
189
danhpheo
D
A
  • Question Question
Copy 2 form sang file khác, có 1 form Show, 1 form không Show
Trả lời
2
Đọc
135
AnhThu-1976
A
R
Các bác có kinh nghiệm excel cho em xin công thức đánh số thứ tự theo ngày tháng này vợi ạ.
Trả lời
5
Đọc
202
truc.duong87
T
H
Tự động cập nhật dữ liệu từ 2 file word (2 người xem)
Trả lời
1
Đọc
151
LOGANWover
L
N
Nhờ giúp Drop down list theo tỉnh xã mới.
Trả lời
7
Đọc
337
ongke0711
ongke0711
E
VBA copy ô trong excel khi đang lọc filter
Trả lời
8
Đọc
202
eagle12
E
N
Không sử dụng được phím tắt Ctrl + Shift + mũi tên xuống
Trả lời
1
Đọc
3K
aFdangthacmac
A
L
  • Question Question
Gõ và chọn tên trong ComboBox hiển thị giá trị trong textbox
    • Cười
Trả lời
8
Đọc
450
ongke0711
ongke0711
befaint
[ Python và ứng dụng ] Công cụ trích xuất hàng loạt hóa đơn điện tử XML vào bảng Excel (2 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
56
Đọc
10K
Hoale85
H
Nam168
Không mở được file excel
Trả lời
2
Đọc
130
Nam168
Nam168
phuongnam366377
Sử dụng COM DLL **không cần đăng ký** với Delphi 12 / C++ Builder
    • Thích
Trả lời
0
Đọc
138
phuongnam366377
phuongnam366377
Xem thêm…

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

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom