Cần giúp đỡ tạo list điều kiện lọc để thực hiện Advanced Filter

DarKLov3 · 18/9/19

Em có một vấn đề cần các anh chị trên diễn đàn giúp đỡ với ạ.
Chả là e có file theo dõi dữ liệu với số lượng dòng tương đối lớn, giờ e muốn lọc theo các điều kiện tại vùng B1: D2 của Sheet "Trichloc". Vùng điều kiện này e muốn tạo list, khi mà đánh 1 số ký tự vào ô B2; C2, Hoặc D2 thì có danh sách xổ xuống để mình chọn cái phù hợp

Code lọc thì em viết như này, nếu có gì chưa ổn nhờ các anh chị sửa giùm

Mã:

Sub Loc()
    '1. Xoa du lieu cu
    Sheets("Trichloc").Range("A8:Q1000").Clear
    '2. Cap nhat ket qua voi advanced Filter
    Sheets("DATA").Range("A5:R65000").AdvancedFilter _
        Action:=xlFilterCopy, _
        CriteriaRange:=Range("B1:D2"), _
        CopyToRange:=Range("A7:Q7"), _
        Unique:=False
    '3. Tim dong cuoi
    Dim lr As Long
        lr = Sheets("Trichloc").Cells(Rows.Count, 1).End(xlUp).Row
    '4. Gan ket qua vao dong cuoi
    With Sheets("Trichloc")
        .Range("B" & lr + 1).Value = Range("S2").Value  'o S2 co doan text la Tong cong
        .Range("P" & lr + 1).Value = Application.WorksheetFunction.Sum(.Range("P8:P" & lr))
        .Range("C" & lr + 4) = "Ngày     tháng      n" & ChrW(259) & "m"
        .Range("C" & lr + 5) = "Ng" & ChrW(432) & ChrW(7901) & "i l" & ChrW(7853) & "p"
        .Range("N" & lr + 4) = "Ngày     tháng      n" & ChrW(259) & "m"
        .Range("N" & lr + 5) = "Ng" & ChrW(432) & ChrW(7901) & "i duyêt"
               
    End With
    '5. Dinh dang
    With Sheets("Trichloc")
        .Range("A" & lr + 1 & ":P" & lr + 1).Style = "Total"
        .Range("P" & lr + 1).NumberFormat = "#,##0"
    End With
   
End Sub

Emc ó gửi file đính kèm, mong các anh chị giúp đỡ.

phulien1902 · 18/9/19

DarKLov3 đã viết:
Em có một vấn đề cần các anh chị trên diễn đàn giúp đỡ với ạ.
Chả là e có file theo dõi dữ liệu với số lượng dòng tương đối lớn, giờ e muốn lọc theo các điều kiện tại vùng B1: D2 của Sheet "Trichloc". Vùng điều kiện này e muốn tạo list, khi mà đánh 1 số ký tự vào ô B2; C2, Hoặc D2 thì có danh sách xổ xuống để mình chọn cái phù hợp

Code lọc thì em viết như này, nếu có gì chưa ổn nhờ các anh chị sửa giùm

Mã:

Sub Loc() '1. Xoa du lieu cu Sheets("Trichloc").Range("A8:Q1000").Clear '2. Cap nhat ket qua voi advanced Filter Sheets("DATA").Range("A5:R65000").AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=Range("B1:D2"), _ CopyToRange:=Range("A7:Q7"), _ Unique:=False '3. Tim dong cuoi Dim lr As Long lr = Sheets("Trichloc").Cells(Rows.Count, 1).End(xlUp).Row '4. Gan ket qua vao dong cuoi With Sheets("Trichloc") .Range("B" & lr + 1).Value = Range("S2").Value 'o S2 co doan text la Tong cong .Range("P" & lr + 1).Value = Application.WorksheetFunction.Sum(.Range("P8:P" & lr)) .Range("C" & lr + 4) = "Ngày tháng n" & ChrW(259) & "m" .Range("C" & lr + 5) = "Ng" & ChrW(432) & ChrW(7901) & "i l" & ChrW(7853) & "p" .Range("N" & lr + 4) = "Ngày tháng n" & ChrW(259) & "m" .Range("N" & lr + 5) = "Ng" & ChrW(432) & ChrW(7901) & "i duyêt" End With '5. Dinh dang With Sheets("Trichloc") .Range("A" & lr + 1 & ":P" & lr + 1).Style = "Total" .Range("P" & lr + 1).NumberFormat = "#,##0" End With End Sub

Emc ó gửi file đính kèm, mong các anh chị giúp đỡ.

Bạn thử:

PHP:

Option Explicit
Sub Test()
    Application.ScreenUpdating = False
    Dim a(), b(), i, j, k, lr, DK1, DK2, DK3, jj
    With Sheets("DATA")
        a = .Range("A6", .Range("A65000").End(3)).Resize(, 18).Value
        lr = UBound(a)
    End With
    ReDim b(1 To lr, 1 To 17)
    With Sheets("DATA")
        DK1 = Sheets("Trichloc").Range("B2").Value
        DK2 = Sheets("Trichloc").Range("C2").Value
        DK3 = Sheets("Trichloc").Range("D2").Value
        For i = 1 To lr
            If a(i, 3) = DK1 And a(i, 4) = DK2 And a(i, 18) = DK3 Then
                k = k + 1
                b(k, 1) = k
                For j = 2 To 5
                    b(k, j) = a(i, j + 1)
                Next
                For jj = 6 To 15
                    b(k, jj) = a(i, jj + 2)
                Next
                b(k, 16) = a(i, 7)
                b(k, 17) = a(i, 18)
            End If
        Next i
        With Sheets("Trichloc")
            .Range("A8:Q1000").ClearContents
            .Range("A8:Q1000").Borders.LineStyle = 0
        End With
        If k Then
            With Sheets("Trichloc")
                .Range("A8").Resize(k, 17) = b
                .Range("A8").Resize(k, 17).Borders.LineStyle = 1
                .Rows(k + 10 & ":1000").Hidden = True
            End With
        End If
        '------------------
        With Sheets("Trichloc")
            lr = .Cells(Rows.Count, 1).End(xlUp).Row
            .Range("P" & lr + 1).Value = Application.WorksheetFunction.Sum(.Range("P8:P" & lr))
             .Range("P" & lr + 1).NumberFormat = "#,##0"
        End With
    End With
End Sub

DarKLov3 · 18/9/19

phulien1902 đã viết:
Bạn thử:

cám ơn bạn, code chạy cũng ok rồi nhưng bạn có thể xem giúp chỗ tạo list điều kiện kia không? vì giờ vẫn phải nhập thủ công vào đó, khi nhập có thể không chính xác giống như dữ liệu trong sheet DATA, dẫn đến không lọc được.
Ví dụ: nếu tạo list ở B2 chọn quyết định số 2099/QĐ-UBND thì khi tích sang ô C2 cũng hiện tên các đơn vị liên quan đến 2099/QĐ-UBND; Ô D2 hiện các số giao dịch của QĐ 2099

DarKLov3 · 19/9/19

Nhờ addin input from list của bác @huuthang_bd và code của bạn @phulien1902 (có sửa 1 chút) em đã giải quyết được vấn đề. Em xin cám ơn mọi người nhé.

thanhphuongvip · 20/9/19

Cho mình hỏi dòng lệnh in đậm mục đích là gì ạ? Nếu không có nó thì có đc ko?
With Sheets("Trichloc")
.Range("A8").Resize(k, 17) = b
.Range("A8").Resize(k, 17).Borders.LineStyle = 1
.Rows(k + 10 & ":1000").Hidden = True
End With

SA_DQ · 20/9/19

Cho mình hỏi dòng lệnh in đậm mục đích là gì ạ? Nếu không có nó thì có đc ko?
With Sheets("Trichloc")
.Range("A8").Resize(k, 17) = b
.Range("A8").Resize(k, 17).Borders.LineStyle = 1
.Rows(k + 10 & ":1000").Hidden = True
End With

Dịch từ ngôn ngữ VBA sa ng tiếng Việt sẽ là vầy:

Cho ẩn các dòng bắt đầu từ dòng có số chứa trong tham biến K +10 đến dòng thứ 1 ngàn
Nếu không có dòng lệnh đó thì nó trơ trơ ra để bạn nhìn thấy chúng trên trang tính;

DarKLov3 · 20/9/19

E thì đã bỏ câu đấy. Thay vào bằng câu set print area cho ẩn hết đi. Nhìn nó ok hơn

thanhphuongvip · 21/9/19

SA_DQ đã viết:
Dịch từ ngôn ngữ VBA sa ng tiếng Việt sẽ là vầy:

Cho ẩn các dòng bắt đầu từ dòng có số chứa trong tham biến K +10 đến dòng thứ 1 ngàn
Nếu không có dòng lệnh đó thì nó trơ trơ ra để bạn nhìn thấy chúng trên trang tính;

Mình biết tác dụng của nó rồi, nhưng mục đích của nó thì chưa hiểu lắm, nếu muốn đẹp thì ẩn hết nó đi, chứ sao chỉ ẩn 1000 dòng thôi, thì đằng nào vẫn còn các dòng còn lại mà?

SA_DQ · 21/9/19

thanhphuongvip đã viết:
Mình biết tác dụng của nó rồi, nhưng mục đích của nó thì chưa hiểu lắm, nếu muốn đẹp thì ẩn hết nó đi, chứ sao chỉ ẩn 1000 dòng thôi, thì đằng nào vẫn còn các dòng còn lại mà?

Mình đoán nha:
Người ta làm hóa đơn hay phiếu xuất kho & cho rằng dữ liệu các mặt hàng không quá 980 dòng
(& các dòng dữ liệu này bắt đầu từ dòng thứ 10)
Phía dưới dòng 1 ngàn còn có các dòng tối quan trọng như tổng các mắt hàng, tổng tiền,. . .
Ngoài ra còng dòng viế`t bằng chữ số tiền & các chức vụ, tên những người kí, ngày tháng,. . .
Vậy nên họ cho ẩn mấy dòng không dữ liệu để vừa mắt bạn ý mà & chúc vui nhân ngày cuối tuần!

DarKLov3 · 5/10/19

ai cóthể đơn giản hóa giúp em code này không ạ. Ý tưởng là code sẽ lọc theo bất cứ điều kiện nào có trong vùng điều kiện. tức là:
Có 1 điều kiện thì lọc theo 1, có 2 lọc 2, có 3 thì lọc cả 3 ạ.
em gửi cả file kèm mong mọi người giúp đỡ

Mã:

For i = 1 To lr
            'neu  chi? có DK1
        If DK2 = "" And DK3 = "" Then
            If a(i, 3) = DK1 Then

                k = k + 1
                b(k, 1) = k
                For j = 2 To 2
                    b(k, j) = a(i, j + 1) ' cot so QD
                Next
                For j = 3 To 3
                    b(k, j) = a(i, j - 1) ' cot noi dung chi

                Next
                For j = 4 To 5
                    b(k, j) = a(i, j + 1) ' so cu la 1

                Next
                For jj = 6 To 15
                    b(k, jj) = a(i, jj + 2) ' sô cu la 2
                Next
                b(k, 16) = a(i, 7)
                b(k, 17) = a(i, 18)

            End If
        ' chi co dieu kien 1 và 2
        ElseIf DK3 = "" Then
            If a(i, 3) = DK1 And a(i, 4) = DK2 Then

                k = k + 1
                b(k, 1) = k
                For j = 2 To 2
                    b(k, j) = a(i, j + 1) ' cot so QD
                Next
                For j = 3 To 3
                    b(k, j) = a(i, j - 1) ' cot noi dung chi

                Next
                For j = 4 To 5
                    b(k, j) = a(i, j + 1) ' so cu la 1

                Next
                For jj = 6 To 15
                    b(k, jj) = a(i, jj + 2) ' sô cu la 2
                Next
                b(k, 16) = a(i, 7)
                b(k, 17) = a(i, 18)

            End If
ElseIf DK1 = "" Then
            If a(i, 4) = DK2 And a(i, 18) = DK3 Then

                k = k + 1
                b(k, 1) = k
                For j = 2 To 2
                    b(k, j) = a(i, j + 1) ' cot so QD
                Next
                For j = 3 To 3
                    b(k, j) = a(i, j - 1) ' cot noi dung chi

                Next
                For j = 4 To 5
                    b(k, j) = a(i, j + 1) ' so cu la 1

                Next
                For jj = 6 To 15
                    b(k, jj) = a(i, jj + 2) ' sô cu la 2
                Next
                b(k, 16) = a(i, 7)
                b(k, 17) = a(i, 18)

            End If

ElseIf DK2 = "" Then
            If a(i, 3) = DK1 And a(i, 18) = DK3 Then

                k = k + 1
                b(k, 1) = k
                For j = 2 To 2
                    b(k, j) = a(i, j + 1) ' cot so QD
                Next
                For j = 3 To 3
                    b(k, j) = a(i, j - 1) ' cot noi dung chi

                Next
                For j = 4 To 5
                    b(k, j) = a(i, j + 1) ' so cu la 1

                Next
                For jj = 6 To 15
                    b(k, jj) = a(i, jj + 2) ' sô cu la 2
                Next
                b(k, 16) = a(i, 7)
                b(k, 17) = a(i, 18)

            End If

        Else 'neu co ca 3 dieu kien
       
            If a(i, 3) = DK1 And a(i, 4) = DK2 And a(i, 18) = DK3 Then

                k = k + 1
                b(k, 1) = k
                For j = 2 To 2
                    b(k, j) = a(i, j + 1) ' cot so QD
                Next
                For j = 3 To 3
                    b(k, j) = a(i, j - 1) ' cot noi dung chi

                Next
                For j = 4 To 5
                    b(k, j) = a(i, j + 1) ' so cu la 1

                Next
                For jj = 6 To 15
                    b(k, jj) = a(i, jj + 2) ' sô cu la 2
                Next
                b(k, 16) = a(i, 7)
                b(k, 17) = a(i, 18)

            End If
        End If
           
        Next i

DarKLov3 · 7/10/19

hic, chưa ai đi ngang qua có hứng thú với vấn đề của em ạ.

Cần giúp đỡ tạo list điều kiện lọc để thực hiện Advanced Filter

DarKLov3

Thành viên chính thức

File đính kèm

phulien1902

GPE - My love

DarKLov3

Thành viên chính thức

DarKLov3

Thành viên chính thức

thanhphuongvip

Mới học VBA, hỏi ngu anh chị đừng chửi ạ

SA_DQ

/(hông là gì!

DarKLov3

Thành viên chính thức

thanhphuongvip

Mới học VBA, hỏi ngu anh chị đừng chửi ạ

SA_DQ

/(hông là gì!

DarKLov3

Thành viên chính thức

File đính kèm

DarKLov3

Thành viên chính thức

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

Facebook

Group

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