Thử:
Sub Loc()
With Sheets("DATA").Range("A2:M2")
.AutoFilter
.AutoFilter Field:=4, Criteria1:="123"
.AutoFilter Field:=12, Criteria1:="PK"
.Range("A2").CurrentRegion.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy Sheets("VBA").Range("A3")
.AutoFilter
End With
End Sub
Vâng em xin giải thích thêm
Sub LocTest()
Dim sArr(), Arr, i As Long, J As Long, K As Long, r As Long, Col As Long, DK As Range, Cll As Range
With Sheets("DATA")
sArr = .Range("A1", .Range("A3").End(xlDown)).Resize(, .Range("A1").End(xlToRight).Column).Value
r = UBound(sArr)
Arr = Sheets("VBA").Range("A1", Sheets("VBA").Range("A1").End(xlToRight)).Value
Col = UBound(Arr, 2)
End With
ReDim dArr(1 To r, 1 To Col)
Set DK = Sheets("VBA").Range("O2:O14")
With CreateObject("Scripting.Dictionary")
For Each Cll In DK
If Cll <> Empty Then .Item(UCase(Cll.Value)) = ""
Next Cll
For i = 1 To r
If .Exists(UCase(sArr(i, 4))) Then 'Lọc cột 4 của sheet"DATA" với điều kiện 123 ở Sheet"VBA" => Làm sao chọn được 1 vùng data từ cột thứ 1 đến cột 13 trong sheet"DATA"
K = K + 1
For J = 1 To Col
dArr(K, J) = sArr(i, Arr(1, J))
Next J
End If
Next i
End With
Sheets("VBA").Range("A3").Resize(1000, Col).ClearContents
If K Then Sheets("VBA").Range("A3").Resize(K, Col) = dArr
Set DK = Nothing
End SubMình đọc kỹ lại xem...
Anh có thể chỉ rõ giúp em vấn đề đang nằm ở đâu. Theo em hiểu ý anh kêu em nhập "=<> " ở phần này
If Cll <> Empty Then .Item(UCase(Cll.Value)) = ""Chắc là nói về cái mà tôi dùng trong bài #14 - thủ thuật "bỏ điều kiện"
Dạ em đang cần hỗ trợ ở topic nàyChắc là nói về cái mà tôi dùng trong bài #14 - thủ thuật "bỏ điều kiện"
https://www.giaiphapexcel.com/diendan/threads/tìm-kiếm-dữ-liệu-theo-nhiều-điều-kiện-trong-một-khoảng-thời-gian.134770/post-856407
Nhưng nhìn kỹ lại thì không đúng
Cái của tôi là "<>="
Set DK = Sheets("VBA").Range("O2:O14") 'vùng điều kiện
------------------
----------------
For i = 1 To r
If .Exists(UCase(sArr(i, 4))) Then 'vùng data để lọc
-----------------
------------------
End WithNhập gì chứ, mình đã nêu được yêu cầu đâu mà nhập nhập.
Ý gì đâu, nghĩa ở mặt chữ.
Chắc em chưa diễn giải 1 cách dễ hiểu nhất, em cũng tự mò và có cách làm cho điều mình cần
Muốn xét hơn 1 điều kiện (đk) thì dùng thêm vòng lặp xét điều kiện thôi.
Sub LocTest()
Dim lastRow As Long, count As Long, r As Long, c As Long, good As Boolean
Dim sArr(), dk(), result(), key, dic As Object
' xoa ket qua cu
Application.EnableEvents = False
Sheets("VBA").Range("A3").Resize(10000, 13).ClearContents
Application.EnableEvents = True
With Sheets("DATA")
lastRow = .Cells(Rows.count, "A").End(xlUp).Row
' khong co du lieu thi ket thuc
If lastRow < 3 Then Exit Sub
sArr = .Range("A3:M" & lastRow).Value
End With
Set dic = CreateObject("Scripting.Dictionary")
dk = Sheets("VBA").Range("O2:O14").Value
For r = 1 To UBound(dk)
If Not IsEmpty(dk(r, 1)) Then dic.Add r, LCase(dk(r, 1)) ' dieu kien dk(r, 1) cho cot r
Next r
If dic.count = 0 Then
' khong co dieu kien, vay coi nhu cac dieu kien deu thoa
Sheets("VBA").Range("A3").Resize(UBound(sArr), UBound(sArr, 2)).Value = sArr
Exit Sub
End If
ReDim result(1 To UBound(sArr), 1 To UBound(sArr, 2))
For r = 1 To UBound(sArr)
good = True
For Each key In dic.keys
If LCase(sArr(r, key)) <> dic.Item(key) Then
' it nhat 1 dk khong thoa vay khong xet tiep dk sau
good = False
Exit For
End If
Next key
If good Then
' neu tat ca cac dk thoa thi lay dong hien hanh
count = count + 1
For c = 1 To UBound(sArr, 2)
result(count, c) = sArr(r, c)
Next c
End If
Next r
If count Then
' neu co ket qua thi nhap xuong sheet
Application.EnableEvents = False
Sheets("VBA").Range("A3").Resize(count, UBound(result, 2)).Value = result
Application.EnableEvents = True
End If
Set dic = Nothing
End Sub
Đến bài này, nhưng bạn giải thích cũng chưa rõ ràng, và chưa có ví dụ cụ thể.
