Lọc dữ liệu theo điều kiện countifs code vba

Chia sẻ bởi:hands

★★★★★

‹ In mail outlook hàng loạt có file... Lọc dữ liệu theo điều kiện ›

Quảng cáo

Dear Anh/ Chị:
Nhờ anh chị hướng dẫn giúp em lọc dữ liệu theo điều kiện Cột Item ="".
1. nếu Type = 301S thì dòng nào Emty ta sẽ lấy dòng đó.
2. Nếu Type = M1 thì ta lấy 2 dòng trống mà thỏa mãn trong 1 Bin.
VD: Ta có BIN DM-043-2 có 2 dòng: dòng Bin DM-043-2/1 cột Item đã chứa dữ liệu. Vì vậy Bin này ta không lọc.
Ngược lại BIN DM-044-3 có 2 dòng đều trống nên ta lọc Bin này.
Bảng Data:
285

Kết quả mong muốn
284

Bạn thử code sau nhé:

Sub TrichLoc_HLMT()
    Dim strSQL As String
     strSQL = "Select * From [Sheet1$A1:L] Where F1 Like '301S' And [F3] Is Null"
     strSQL = strSQL & " Union All Select a.* From [Sheet1$A1:L] a Inner Join (Select F12 From [Sheet1$A1:L] Where F1 Like 'M1' And F3 Is Null Group By F12 Having Count(F12)>1) b On a.F12=b.F12"
    With CreateObject("ADODB.Recordset")
        .Open (strSQL), "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0 Xml;HDR=No;IMEX=1"""
        Sheet2.Range("P23").CopyFromRecordset .DataSource
    End With
End Sub

www.giaiphapexcel.com/diendan/threads/l%E1%BB%8Dc-d%E1%BB%AF-li%E1%BB%87u-theo-%C4%91i%E1%BB%81u-ki%E1%BB%87n-countifs-code-vba.163314/

Thêm 1 cách khác, cù lần nhất có thể:

Sub LocTheoDieuKien()
Dim Rws As Long, J As Long, W As Integer
Dim Arr()
Const GPE = "<=..=>"

Rws = .CurrentRegion.Rows.Count
Arr() = .Resize(Rws, 12).Value
ReDim aKQ(1 To Rws, 1 To 5)
For J = 1 To UBound(Arr())
If Arr(J, 1) = "301S" And Arr(J, 3) = "" Then
W = W + 1: aKQ(W, 1) = Arr(J, 1)
aKQ(W, 2) = Arr(J, 2): aKQ(W, 4) = GPE
aKQ(W, 5) = Arr(J, 12)
ElseIf Arr(J, 1) = "M1" And Arr(J, 3) = "" Then
If Arr(J + 1, 3) = "" And Arr(J + 1, 12) = Arr(J, 12) Then
W = W + 1: aKQ(W, 1) = Arr(J, 1)
aKQ(W, 2) = Arr(J, 2): aKQ(W, 4) = GPE
aKQ(W, 5) = Arr(J, 12)
W = W + 1: aKQ(W, 1) = Arr(J + 1, 1)
aKQ(W, 2) = Arr(J + 1, 2): aKQ(W, 4) = GPE
aKQ(W, 5) = Arr(J + 1, 12)
End If
End If
Next J
MsgBox "Sô Dòng Kêt Qua Loc Là: " & W
End Sub