Trợ giúp Code VBA_Lọc theo điều kiện giữ nguyên tiêu đề của nhóm công việc

quyenpv · 9/5/22

Em có Sheet dữ liệu được giao công việc qua các tháng, trưởng phòng em muốn lọc dữ liệu giao được nhìn và biết nhóm mảng công việc sau Filter

Dữ liệu ban đầu cho công việc các tháng

Dữ liệu lọc các công việc trong tháng 3 với cột B và các công việc quá hạn cột L

Khi Áp dụng Filter 2 cột B và cột L theo điều kiện trên sẽ ra được kết quả nhưng mất toàn bộ các dòng tiêu đề nhóm công việc, mong các anh hỗ trợ giúp làm sao lọc có thể giữa nguyên được tiêu đề A, B, C của các dong
Em cám ơn

quyenpv · 10/5/22

Maika8008 đã viết:
Đang dùng cột B làm điều kiện chạy sự kiện filter và đồng thời cột B lọc ngày tháng nên rối rắm lung tung

Dạ có cách nào anh chỉ giúp em ạ. Em cám ơn

CHAOQUAY · 10/5/22

quyenpv đã viết:
Dạ được anh anh ạ, anh giúp em với

Bạn tham khảo file đính kèm.

Ngày tháng lọc theo cột P.
Mức độ hoàn thành theo cột Q. Cột này bạn lọc theo chế độ contains

Mã:

Option Explicit

Sub cothu()
Dim Nguon
Dim chuoiTh
Dim Kq
Dim rws, i, j, k

If ActiveSheet.AutoFilterMode Then
    ActiveSheet.AutoFilterMode = False
End If

Nguon = Sheet1.Range("A4:O38")
rws = UBound(Nguon)
ReDim Kq(1 To rws, 1 To 2)

With CreateObject("Scripting.Dictionary")
    For i = 2 To rws
        If Nguon(i, 12) <> "" Then
            .Item(Nguon(i, 12)) = ""
        End If
    Next i
    chuoiTh = Join(.keys)
End With

For i = 2 To rws
    If IsDate(Nguon(i, 2)) = False Then
        For j = i + 1 To rws
            If IsDate(Nguon(j, 2)) = True Then
                Kq(i, 1) = Nguon(j, 2)
                Exit For
            End If
        Next j
    Else
        Kq(i, 1) = Nguon(i, 2)
    End If
    
    If Nguon(i, 12) = "" Then
        Kq(i, 2) = chuoiTh
    Else
        Kq(i, 2) = Nguon(i, 12)
    End If
Next i
Sheet1.Range("P4").Resize(rws, 2) = Kq
End Sub

HUONGHCKT · 10/5/22

quyenpv đã viết:
Em có Sheet dữ liệu được giao công việc qua các tháng, trưởng phòng em muốn lọc dữ liệu giao được nhìn và biết nhóm mảng công việc sau Filter

Dữ liệu ban đầu cho công việc các tháng
View attachment 275673
Dữ liệu lọc các công việc trong tháng 3 với cột B và các công việc quá hạn cột L
View attachment 275672
Khi Áp dụng Filter 2 cột B và cột L theo điều kiện trên sẽ ra được kết quả nhưng mất toàn bộ các dòng tiêu đề nhóm công việc, mong các anh hỗ trợ giúp làm sao lọc có thể giữa nguyên được tiêu đề A, B, C của các dong
Em cám ơn

Nếu vẫn còn quan tâm thì hãy thử xem file.
Làm bằng VBA nhưng vẫn phải thêm cột phụ. Tuy nhiên cho ra kết quả đúng như yêu cầu.
2 combobox (3 và 4) sẽ cho bạn có nhiều lựa chọn tiêu chí để lọc hơn.
Bạn click vào nút ShowForm để chọn các tiêu chí lọc và nhấn nút LỌC để xem kết quả.
P/S: Code tôi tự viết nên tự cảm nhận thấy có thể còn vòng vèo, mong anh chị em ghé qua xem, và cho ý kiến để hoàn thiện. để các bạn mới tập viết code( trong đó có tôi có thể có thêm kiến thức để học).
Trân trọng!

quyenpv · 10/5/22

HUONGHCKT đã viết:
Nếu vẫn còn quan tâm thì hãy thử xem file.
Làm bằng VBA nhưng vẫn phải thêm cột phụ. Tuy nhiên cho ra kết quả đúng như yêu cầu.
2 combobox (3 và 4) sẽ cho bạn có nhiều lựa chọn tiêu chí để lọc hơn.
Bạn click vào nút ShowForm để chọn các tiêu chí lọc và nhấn nút LỌC để xem kết quả.
P/S: Code tôi tự viết nên tự cảm nhận thấy có thể còn vòng vèo, mong anh chị em ghé qua xem, và cho ý kiến để hoàn thiện. để các bạn mới tập viết code( trong đó có tôi có thể có thêm kiến thức để học).
Trân trọng!

Dạ cám ơn anh
Code đang lỗi đoạn này ạ

Trong user form anh đã thiết lập

Không hiểu sau ghi dữ liệu ra tại ô AB1 lại bị định dạng này ạ

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

CHAOQUAY đã viết:

Bạn tham khảo file đính kèm.

Ngày tháng lọc theo cột P.
Mức độ hoàn thành theo cột Q. Cột này bạn lọc theo chế độ contains

Mã:

Option Explicit

Sub cothu()
Dim Nguon
Dim chuoiTh
Dim Kq
Dim rws, i, j, k

If ActiveSheet.AutoFilterMode Then
    ActiveSheet.AutoFilterMode = False
End If

Nguon = Sheet1.Range("A4:O38")
rws = UBound(Nguon)
ReDim Kq(1 To rws, 1 To 2)

With CreateObject("Scripting.Dictionary")
    For i = 2 To rws
        If Nguon(i, 12) <> "" Then
            .Item(Nguon(i, 12)) = ""
        End If
    Next i
    chuoiTh = Join(.keys)
End With

For i = 2 To rws
    If IsDate(Nguon(i, 2)) = False Then
        For j = i + 1 To rws
            If IsDate(Nguon(j, 2)) = True Then
                Kq(i, 1) = Nguon(j, 2)
                Exit For
            End If
        Next j
    Else
        Kq(i, 1) = Nguon(i, 2)
    End If
   
    If Nguon(i, 12) = "" Then
        Kq(i, 2) = chuoiTh
    Else
        Kq(i, 2) = Nguon(i, 12)
    End If
Next i
Sheet1.Range("P4").Resize(rws, 2) = Kq
End Sub

Dạ code của anh nhanh gọn, cái này khi đưa vào sự kiện Sheet Active tự chạy code của anh được không ạ để cập nhật điều kiện lọc cho cột phụ ạ

CHAOQUAY · 11/5/22

quyenpv đã viết:
...
Dạ code của anh nhanh gọn, cái này khi đưa vào sự kiện Sheet Active tự chạy code của anh được không ạ để cập nhật điều kiện lọc cho cột phụ ạ

Chuột phải vào sheet tab, chọn view code, dán đoạn code dưới đây vào

Mã:

Option Explicit

Private Sub Worksheet_Activate()
Call cothu
End Sub

quyenpv · 11/5/22

CHAOQUAY đã viết:
Chuột phải vào sheet tab, chọn view code, dán đoạn code dưới đây vào

Mã:

Option Explicit Private Sub Worksheet_Activate() Call cothu End Sub

Dạ cám ơn anh CHAOQUAY
Em làm thử ngày chỗ ngày với điều kiện ngày bắt đầu tại U1, Ngày kết thúc tại U2 và điều kiện lọc tại U3 nhưng không lọc được không có lỗi xảy ra không hiểu lý do gì
Nhờ anh kiểm tra giúp em ạ

Mã:

Sub Filter()
    Dim lr
    lr = Range("B" & Rows.Count).End(xlUp).Row
    With Sheet1
        fDay = .Range("U1").Value
        eDay = .Range("U2").Value
        If fDay = Empty Then fDay = DateValue("1000/1/1")
        If eDay = Empty Then eDay = DateValue("2100/1/1")
    End With
    
    Range("A4:Q" & lr).AutoFilter Field:=16, Criteria1:=">=" & CDbl(fDay), Operator:=xlAnd, Criteria2:="<=" & CDbl(eDay)

    Range("A4:Q" & lr).AutoFilter Field:=17, Criteria1:="=" & Sheet1.Range("U3")    ', Operator:=xlAnd
End Sub

CHAOQUAY · 11/5/22

quyenpv đã viết:
Dạ cám ơn anh CHAOQUAY
Em làm thử ngày chỗ ngày với điều kiện ngày bắt đầu tại U1, Ngày kết thúc tại U2 và điều kiện lọc tại U3 nhưng không lọc được không có lỗi xảy ra không hiểu lý do gì
Nhờ anh kiểm tra giúp em ạ
View attachment 275760

Mã:

Sub Filter() Dim lr lr = Range("B" & Rows.Count).End(xlUp).Row With Sheet1 fDay = .Range("U1").Value eDay = .Range("U2").Value If fDay = Empty Then fDay = DateValue("1000/1/1") If eDay = Empty Then eDay = DateValue("2100/1/1") End With Range("A4:Q" & lr).AutoFilter Field:=16, Criteria1:=">=" & CDbl(fDay), Operator:=xlAnd, Criteria2:="<=" & CDbl(eDay) Range("A4:Q" & lr).AutoFilter Field:=17, Criteria1:="=" & Sheet1.Range("U3") ', Operator:=xlAnd End Sub

Sub cothu, bạn thêm dòng lệnh như bên dưới để chuyển format về mặc định

Mã:

Sheet1.Range("P4").Resize(rws, 2).Clear'<---them
Sheet1.Range("P4").Resize(rws, 2) = Kq
End Sub

Sub Filter, bạn sửa điều kiện lọc như bên dưới. Đây là lọc theo contains như bài trên có nói

Mã:

'Range("A4:Q" & lr).AutoFilter Field:=17, Criteria1:="=" & Sheet1.Range("U3")    ', Operator:=xlAnd
Range("A4:Q" & lr).AutoFilter Field:=17, Criteria1:="=*" & Sheet1.Range("U3") & "*"   ', Operator:=xlAnd

goodlife1605 · 11/5/22

quyenpv đã viết:
Em có Sheet dữ liệu được giao công việc qua các tháng, trưởng phòng em muốn lọc dữ liệu giao được nhìn và biết nhóm mảng công việc sau Filter

Dữ liệu ban đầu cho công việc các tháng
View attachment 275673
Dữ liệu lọc các công việc trong tháng 3 với cột B và các công việc quá hạn cột L
View attachment 275672
Khi Áp dụng Filter 2 cột B và cột L theo điều kiện trên sẽ ra được kết quả nhưng mất toàn bộ các dòng tiêu đề nhóm công việc, mong các anh hỗ trợ giúp làm sao lọc có thể giữa nguyên được tiêu đề A, B, C của các dong
Em cám ơn

Bạn thử điền điều kiện cột B vào ô F1 và điều kiện cột L vào ô F2 rồi nhấn nút FILTER xem sao.

quyenpv · 11/5/22

goodlife1605 đã viết:
Bạn thử điền điều kiện cột B vào ô F1 và điều kiện cột L vào ô F2 rồi nhấn nút FILTER xem sao.

Dạ anh chạy đúng ạ
Nhưng yêu cầu của em đang muốn chạy kiểm tra từ ngày đến ngày, anh giúp em đoạn này với nhé

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

CHAOQUAY đã viết:
Sub cothu, bạn thêm dòng lệnh như bên dưới để chuyển format về mặc định

Mã:

Sheet1.Range("P4").Resize(rws, 2).Clear'<---them Sheet1.Range("P4").Resize(rws, 2) = Kq End Sub

Sub Filter, bạn sửa điều kiện lọc như bên dưới. Đây là lọc theo contains như bài trên có nói

Mã:

'Range("A4:Q" & lr).AutoFilter Field:=17, Criteria1:="=" & Sheet1.Range("U3") ', Operator:=xlAnd Range("A4:Q" & lr).AutoFilter Field:=17, Criteria1:="=*" & Sheet1.Range("U3") & "*" ', Operator:=xlAnd

Dạ cám ơn anh! Code chạy tốt rồi ạ

goodlife1605 · 11/5/22

quyenpv đã viết:
Dạ anh chạy đúng ạ
Nhưng yêu cầu của em đang muốn chạy kiểm tra từ ngày đến ngày, anh giúp em đoạn này với nhé

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

Dạ cám ơn anh! Code chạy tốt rồi ạ

Bạn thử lại xem sao nhé. Chủ yếu dùng cột phụ, không nặng về VBA.

Trợ giúp Code VBA_Lọc theo điều kiện giữ nguyên tiêu đề của nhóm công việc

quyenpv

Thu nhặt kiến thức

File đính kèm

quyenpv

Thu nhặt kiến thức

CHAOQUAY

Thành viên gắn bó

File đính kèm

HUONGHCKT

Zalo 0986997214

File đính kèm

quyenpv

Thu nhặt kiến thức

CHAOQUAY

Thành viên gắn bó

quyenpv

Thu nhặt kiến thức

File đính kèm

CHAOQUAY

Thành viên gắn bó

goodlife1605

Thành viên mới

File đính kèm

quyenpv

Thu nhặt kiến thức

goodlife1605

Thành viên mới

File đính kèm

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

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