không dùng code AdvancedFilter mà vẫn lọc theo nhiều điều kiện

[NguyenthiH]

Chào các anh chị!
Em có file này, trong file em dùng code AdvancedFilter để lọc theo nhiều điều kiện, giờ em nhờ các anh chị giúp code khác để vẫn lọc theo nhiều điều kiện được, và để làm sao khi không lọc thì bảng lọc không có dữ liệu (AdvancedFilter thì không lọc nó cũng hiện dữ liệu vào bảng), tức là lọc dữ liệu tới đâu hiện dữ liệu tới đó và chổ không có dữ liệu thì không có border.

 

[Hau151978]

Chào các anh chị!
Em có file này, trong file em dùng code AdvancedFilter để lọc theo nhiều điều kiện, giờ em nhờ các anh chị giúp code khác để vẫn lọc theo nhiều điều kiện được, và để làm sao khi không lọc thì bảng lọc không có dữ liệu (AdvancedFilter thì không lọc nó cũng hiện dữ liệu vào bảng), tức là lọc dữ liệu tới đâu hiện dữ liệu tới đó và chổ không có dữ liệu thì không có border.

Bạn thêm lệnh xóa range("B5:G2000") trước khi filter là được.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Rng As Range
    Application.ScreenUpdating = False
    Set Rng = Sheet1.[B4].CurrentRegion
    If Not Intersect(Target, Sheet2.[B2:F2]) Is Nothing Then
        Range("B5:G2000").Clear
        Rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheet2.Range( _
            "B1:F2"), CopyToRange:=Sheet2.Range("B4:G4"), unique:=False
        Range("G2").Value = Application.Sum([G5:G2000])
    End If
    Application.ScreenUpdating = True
End Sub

 

[be_09]

Chào các anh chị!
Em có file này, trong file em dùng code AdvancedFilter để lọc theo nhiều điều kiện, giờ em nhờ các anh chị giúp code khác để vẫn lọc theo nhiều điều kiện được, và để làm sao khi không lọc thì bảng lọc không có dữ liệu (AdvancedFilter thì không lọc nó cũng hiện dữ liệu vào bảng), tức là lọc dữ liệu tới đâu hiện dữ liệu tới đó và chổ không có dữ liệu thì không có border.

Code Advanced Filter là nhanh và ngắn gọn nhất mà không dùng, thì dùng cái gì nữa bây giờ.
Nên bỏ code vào Module rồi Dùng Worksheet_Change gọi nó, nếu dùng trong sheet mà dữ liệu lớn thì làm chậm tốc độ, nếu máy yếu thì có thể đơ máy.
Tốt nhất là bỏ cái vụ Worksheet_Change, cho code vào Module luôn rồi gán code đó cho 1 nút khi cần thì nhấn nút.

 

[NguyenthiH]

Cám ơn bạn Hau151978.
Mình có thêm đoạn code vầy để khi lọc không có dữ liệu thì có MsgBox"Không có dữ liệu", nhưng bị lỗi, bạn xem chỉnh dùm mình nhé(mình gà VBA lắm)

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Rng As Range
 Set Rng = Sheet1.[B4].CurrentRegion
 If Not Intersect(Target, Sheet2.[B2:F2]) Is Nothing Then
  Range("B5:G2000").Clear
   Rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheet2.Range( _
        "B1:F2"), CopyToRange:=Sheet2.Range("B4:G4"), unique:=False
        Range("G2").Value = Application.Sum([G5:G2000])
   If Range("B5:G8") = Empty Then MsgBox ("Khong co du lieu")'->   bị lỗi'
 End If
End Sub

 

[Hau151978]

Code Advanced Filter là nhanh và ngắn gọn nhất mà không dùng, thì dùng cái gì nữa bây giờ.
Nên bỏ code vào Module rồi Dùng Worksheet_Change gọi nó, nếu dùng trong sheet mà dữ liệu lớn thì làm chậm tốc độ, nếu máy yếu thì có thể đơ máy.

Em thì ghét thủ tục sự kiện lắm, bị lỗi giữa chừng thì có khi lần sau không chạy được do enableevent=false.
Đối với trường hợp advanced filter này, nếu dữ liệu lớn thì nên cho code vào module, gọi thủ công bằng nút bấm vì có nhiều 4 điều kiện, nếu muốn sửa các điều kiện này thì thủ tục sự kiện phải chạy 4 lần.

Bài đã được tự động gộp: 5/7/18

Cám ơn bạn Hau151978.
Mình có thêm đoạn code vầy để khi lọc không có dữ liệu thì có MsgBox"Không có dữ liệu", nhưng bị lỗi, bạn xem chỉnh dùm mình nhé(mình gà VBA lắm)

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range
Set Rng = Sheet1.[B4].CurrentRegion
If Not Intersect(Target, Sheet2.[B2:F2]) Is Nothing Then
  Range("B5:G2000").Clear
   Rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheet2.Range( _
        "B1:F2"), CopyToRange:=Sheet2.Range("B4:G4"), unique:=False
        Range("G2").Value = Application.Sum([G5:G2000])
   If Range("B5:G8") = Empty Then MsgBox ("Khong co du lieu")'->   bị lỗi'
End If
End Sub

Range gồm nhiều ô như vậy không thể so sánh với empty được, bạn phải so từng ô hoặc dùng application.counta.

 

[NguyenthiH]

Cám ơn bạn Hau151978 nhé!!!

 

[NguyenthiH]

Em có file này, dùng code AdvancedFilter để lọc, mà khi em gỏ vào D3 số 6262, lại báo không có dữ liệu, mặc dù trong cột D (Docket) có 6262_6296(Chuỗi). Mong các anh chị giúp đỡ.

 

[Ba Tê]

Em có file này, dùng code AdvancedFilter để lọc, mà khi em gỏ vào D3 số 6262, lại báo không có dữ liệu, mặc dù trong cột D (Docket) có 6262_6296(Chuỗi). Mong các anh chị giúp đỡ.

Muốn tìm "giống giống" thì nhập "6262*" khỏi cần sửa code.

 

[NguyenthiH]

Cám ơn Thầy Ba Tê, nhưng ý của sếp là muốn gỏ làm sao để "giống giống" nò đều ra hết.
Chứ có biết DocKet nào là có gạch nối (tức nhập phụ liệu chung cho cả DocKet này và DocKet kia), DocKet nào không có gạch nối (tức chỉ có nhập phụ liệu riêng cho một DocKet đó)
Vì em gỏ 6187* thì lại báo không có dữ liệu.
Tức chỉnh code để một cách gỏ là tìm "Chính Xác" và cả "Giống Giống"

Bài đã được tự động gộp: 7/7/18

Mà em thấy cũng lạ, là cột "Tên Phụ Liệu" chỉ cần gỏ chữ "d" là nó sẽ lọc ra hết tên Phụ liệu có "D", chứ cột DocKet mà gỏ "6" thì bào không có dữ liệu.

 

[be_09]

Em có file này, dùng code AdvancedFilter để lọc, mà khi em gỏ vào D3 số 6262, lại báo không có dữ liệu, mặc dù trong cột D (Docket) có 6262_6296(Chuỗi). Mong các anh chị giúp đỡ.

Gõ dấu * đằng trước nhé:
*6262

 

[Ba Tê]

Cám ơn Thầy Ba Tê, nhưng ý của sếp là muốn gỏ làm sao để "giống giống" nò đều ra hết.
Chứ có biết DocKet nào là có gạch nối (tức nhập phụ liệu chung cho cả DocKet này và DocKet kia), DocKet nào không có gạch nối (tức chỉ có nhập phụ liệu riêng cho một DocKet đó)
Vì em gỏ 6187* thì lại báo không có dữ liệu.
Tức chỉnh code để một cách gỏ là tìm "Chính Xác" và cả "Giống Giống"

Chính xác rồi nhưng nếu còn có mấy cái "Giống giống" nữa thì sao?
Ví dụ vừa có 6262, vừa có 6262-6296, mà sếp chỉ muốn lọc 6262 thì ... nó lòi ra luôn 6262-6296. Điếc luôn!
"Sếp" này chắc hơi "yếu trong mình"

 

[NguyenthiH]

Cám ơn Thầy Ba Tê!
Sếp em Bụng Bự, mặt "Cau Có" "Khó Chịu", không "Đẹp Trai", "Răng Khểnh" như Thầy, nên hơi "Yếu Trong Mình"
Hay quá Thầy ơi, không dùng AdvancedFilter mà xài "Mảng" vẫn lọc ngon lành.

 

[Ba Tê]

Cám ơn Thầy Ba Tê!
Sếp em Bụng Bự, mặt "Cau Có" "Khó Chịu", không "Đẹp Trai", "Răng Khểnh" như Thầy, nên hơi "Yếu Trong Mình"
Hay quá Thầy ơi, không dùng AdvancedFilter mà xài "Mảng" vẫn lọc ngon lành.

Tất cả: Bụng Bự, mặt "Cau Có" "Khó Chịu", không "Đẹp Trai", "Răng Khểnh" --> như thầy?
Xem lại file này, không có điều kiện nào thì không lọc.

 

[NguyenthiH]

Cám ơn Thầy Ba Tê!
Xài CountA hay quá Thầy ơi!!!

 

[NguyenthiH]

Thầy Ba Tê ơi sao em bắt chước code của Thầy cho file này mà không được.
Mong Thầy xem giúp.

 

[Ba Tê]

Thầy Ba Tê ơi sao em bắt chước code của Thầy cho file này mà không được.
Mong Thầy xem giúp.

Spoiler: Xem cái này

Public Sub Loc()
Application.ScreenUpdating = False
If Application.WorksheetFunction.CountA(Range("A2:E2")) = 0 Then
    Range("A5:F1000").ClearContents
    Range("A5:F1000").Borders.LineStyle = 0
    Exit Sub
End If

Dim sArr(), dArr(), tArr(), I As Long, J As Long, K As Long, N As Long, R As Long, DK As Boolean
sArr = Sheet1.Range("B4", Sheet1.Range("B4").End(xlDown)).Resize(, 6).Value
R = UBound(sArr)
ReDim dArr(1 To R, 1 To 6)
With Sheets("XemPL")
    tArr = .Range("A2:E2").Value
    For I = 1 To R
        DK = False
        For N = 1 To 5
            If Not UCase(sArr(I, N)) Like UCase(tArr(1, N)) & "*" Then
                DK = True
                Exit For
            End If
        Next N
        If DK = False Then
            K = K + 1
            For J = 1 To 6
                dArr(K, J) = sArr(I, J)
            Next J
        End If
    Next I
    .Range("A5").Resize(1000, 6).ClearContents
    .Range("A5").Resize(1000, 6).Borders.LineStyle = 0
    If K Then
        .Range("A5").Resize(K, 6) = dArr
        .Range("A5").Resize(K, 6).Borders.LineStyle = 1
    Else
        MsgBox "Khong co du lieu.", , "GPE"
    End If
    Range("F2").Value = Application.Sum([F5:F2000])
End With
End Sub

 

[NguyenthiH]

Cám ơn Thầy Ba Tê!

 

[huongmuine]

Xin nhờ Thầy Ba Tê và các anh chị chỉ giúp.
Với file trên mình thêm điều kiện lọc trong khoảng thời gian tại K1 và K2 nhưng không lọc được kết quả chính xác.

 

[Ba Tê]

Xin nhờ Thầy Ba Tê và các anh chị chỉ giúp.
Với file trên mình thêm điều kiện lọc trong khoảng thời gian tại K1 và K2 nhưng không lọc được kết quả chính xác.

K1, K2 bắt buộc phải nhập.
B3:H3 phải có ít nhất 1 điều kiện.

Public Sub YeuTrongMinh()
Application.ScreenUpdating = False
If Application.WorksheetFunction.CountA(Range("B3:H3")) = 0 Then
    Range("A6:H1000").ClearContents
    Range("A6:H1000").Borders.LineStyle = 0
    Exit Sub
End If
Dim sArr(), dArr(), tArr(), I As Long, J As Long, K As Long, N As Long, R As Long, DK As Boolean, Dk1 As Date, Dk2 As Date
sArr = Sheet1.Range("B6", Sheet1.Range("B6").End(xlDown)).Resize(, 8).Value
R = UBound(sArr)
ReDim dArr(1 To R, 1 To 8)
With Sheets("GPE")
    tArr = .Range("B3:H3").Value
    Dk1 = .[K1].Value
    Dk2 = .[K2].Value
    For I = 1 To R
    If sArr(I, 1) >= Dk1 And sArr(I, 1) <= Dk2 Then
        DK = False
        For N = 1 To 7
            If Not UCase(sArr(I, N + 1)) Like "*" & UCase(tArr(1, N)) & "*" Then
                DK = True
                Exit For
            End If
        Next N
        If DK = False Then
            K = K + 1
            For J = 1 To 8
                dArr(K, J) = sArr(I, J)
            Next J
        End If
    End If
    Next I
    .Range("A6").Resize(1000, 8).ClearContents
    .Range("A6").Resize(1000, 8).Borders.LineStyle = 0
    If K Then
        .Range("A6").Resize(K, 8) = dArr
        .Range("A6").Resize(K, 8).Borders.LineStyle = 1
    Else
        MsgBox "Khong co du lieu.", , "GPE"
    End If
End With
End Sub

 

[huongmuine]

K1, K2 bắt buộc phải nhập.
B3:H3 phải có ít nhất 1 điều kiện.

Xin cảm ơn Thầy nhiều ạ.