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

Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
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?

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 :) ... With Sheets("Filter") CusName = Split(";" & .Range("B1").Value, ";") ... For i = 1 To UBound(sArr, 1) For J = 1 To...
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
 
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

N
Khắc phục lỗi "The picture is too large and will be truncated" (12 người xem)
Trả lời
9
Đọc
5K
SonBDND
S
GPE-Trợ Lý
[GPE] TALKSHOW: PHÂN TÍCH BÁO CÁO ĐỘ NHẠY SỬ DỤNG EXCEL SOLVER (9 người xem)
Trả lời
0
Đọc
33
GPE-Trợ Lý
GPE-Trợ Lý
D
  • Question Question
Quản lý email outlook qua VBA cần giúp đỡ (4 người xem)
Trả lời
10
Đọc
143
nguyendang95
N
K
  • Question Question
nhờ ace giúp đỡ tự động filter và In hàng loạt từng mục trong piviot table
Trả lời
1
Đọc
76
khkkh
K
G
Xin Code xóa Module. (3 người xem)
Trả lời
0
Đọc
34
GCQ
G
K
Xin dax tính tỷ trọng doanh thu (2 người xem)
Trả lời
18
Đọc
750
SteveNguyen1991
S
F
  • Question Question
Tự động Merge Mail bằng VBA
Trả lời
6
Đọc
181
Hoàng Tuấn 868
H
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 (2 người xem)
    • Thích
Trả lời
0
Đọc
77
nguyendang95
N
H
Nhờ anh/chị giúp đỡ em viết công thức trừ dữ liệu theo FiFo (3 người xem)
Trả lời
1
Đọc
94
HieuCD
H
BNTT
LockXLS - Chương trình bảo vệ an toàn cho các file bảng tính Excel
    • Thích
4 5 6
Trả lời
118
Đọc
73K
YêuCN
Y
vsitcnh
Hỗ trợ công thức tính điểm dựa theo điều kiện.
Trả lời
14
Đọc
191
thuytrangbp28
T
micam111
  • Question Question
Cách chạy nhiều đồng hồ đếm giờ trong VBA
Trả lời
4
Đọc
690
thuytrangbp28
T
B
Xin giải pháp chống sửa, xóa dữ liệu đã nhập vào từ ngày hôm trước. (2 người xem)
    • Thích
2
Trả lời
26
Đọc
7K
Tuấn Bụng Bự
Tuấn Bụng Bự
Emyeuexcel
  • Question Question
In tất cả các file trong cùng 1 thư mục (1 người xem)
Trả lời
3
Đọc
206
Hoàng Tuấn 868
H
L
Lỗi font khi convert từ pdf (2 người xem)
Trả lời
2
Đọc
101
DeTong
D
1
Hỏi về đánh dấu hàng ngang hàng dọc bằng màu khi kích chuột vào 1 ô
Trả lời
7
Đọc
198
Gà Công Nghệ
Gà Công Nghệ
PhanTuHuong
Sách Lập trình VBA trong AutoCAD đã có mặt (1 người xem)
    • Thích
    • Yêu thích
2
Trả lời
20
Đọc
1K
Mr.hieudoanxd
Mr.hieudoanxd
P
Excell code vba : Tìm Cell để sửa dữ liệu
    • Buồn
2
Trả lời
26
Đọc
577
Phạm Trường 80
P
D
Nhờ anh em giúp đỡ. (2 người xem)
    • Buồn
Trả lời
2
Đọc
92
SA_DQ
SA_DQ
00029591
Cần hỗ trợ công thức tổng hợp dữ liệu không cần cột phụ Vlookup (2 người xem)
Trả lời
2
Đọc
101
DeTong
D
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

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
TALK SHOW: CÙNG NHẢY LAM BA ĐA VỚI HÀM LAMBDA (λ) EXCEL 365
Back
Top Bottom