Giúp Filter nâng cao (1 người xem)

[tueyennhi]

Chào anh chị!

Em có file tra cứu code Tỉnh, huyện xã như file đính kèm.
Em muốn cách Filter linh động và đa dạng như sau:

- Bước 1: Căn cứ giá trị tại F1 --> Lọc giá trị này trong vùng Cột A và B bắt đầu từ dòng 6.
- Bước 2: Căn cứ giá trị tại F2 --> Lọc giá trị này trong vùng Cột C, D và E bắt đầu từ dòng 6. (Kết quả lọc tại bước 1 vẫn giữ nguyên)
- Bước 3: Căn cứ giá trị tại F3 -->Lọc giá trị này trong vùng F, G và H bắt đầu từ dòng 6. (Kết quả lọc tại bước 1 và 2 vẫn giữ nguyên)

Nếu giá trị lọc không có ở bước nào thì không lọc ở bước đó.

Nói cách khác sẽ có ba vùng lọc không ảnh hưởng lẫn nhau. Nếu em giải thích còn mơ hồ thì anh chị góp ý cho em nhé.

Em cảm ơn!

 

[befaint]

Nói cách khác sẽ có ba vùng lọc không ảnh hưởng lẫn nhau

Bảng tính Excel khi sinh ra thì dòng và cột dính với nhau, khi lọc thì không thể cắt dời từng cột (vùng) ra được. Tạo 3 cái sheets rồi lọc thôi.

 

[tueyennhi]

Ngẫm lại mới thấy bài này ngớ ngẩn thật. Vậy chỉ còn cách qua bảng số liệu tạo một sheet khác để thể hiện cái kết quả filter. Cảm ơn Befaint!

 

[be_09]

Ngẫm lại mới thấy bài này ngớ ngẩn thật. Vậy chỉ còn cách qua bảng số liệu tạo một sheet khác để thể hiện cái kết quả filter. Cảm ơn Befaint!

Không lẽ Filter rồi Copy qua, dùng Advanced Filter (khỏi copy).

 

[tueyennhi]

Không lẽ Filter rồi Copy qua, dùng Advanced Filter (khỏi copy).

Mình chưa hiểu cách của bạn nói. Bạn có thể nói rõ hơn được không?

 

[be_09]

Mình chưa hiểu cách của bạn nói. Bạn có thể nói rõ hơn được không?

Đọc bài hướng dẫn ở Link sau:

http://www.giaiphapexcel.com/diendan/threads/tìm-hiểu-về-advanced-filter.8/

http://www.giaiphapexcel.com/diendan/threads/cách-sử-dụng-advanced-filter.25471/

Bài viết của Nguyễn Duy Tuân ở Link sau:
http://bluesofts.net/kien-thuc-excel/325-advanced-filter-loc-du-lieu-co-nhieu-dieu-kien.html

 

[ndu96081631]

Mình chưa hiểu cách của bạn nói. Bạn có thể nói rõ hơn được không?

Thì Advanced Filter 3 lần, copy ra 3 nơi thôi

 

[Hoang2013]

Có thể tham khảo file này lúc rỗi:

Mong rằng nó hữu ích tí xíu nào đó với bạn.

[Bổ sung tô màu cho lòe loẹt nè:]

Option Explicit
Dim MyColor As Byte
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Rng As Range, sRng As Range, Arr()
 Dim MaDD As Long, Rws As Long, J As Long, W As Integer
 Dim DD As String
   
 If Not Intersect(Target, [F1]) Is Nothing Then
    [ab1].CurrentRegion.Offset(1).ClearContents
    Set Rng = Range([A6], [A6].End(xlDown))
    Set sRng = Rng.Find(Target.Value, , xlFormulas, xlWhole)
    [ad2].CurrentRegion.Offset(1).ClearContents
    If Not sRng Is Nothing Then
        MaDD = sRng.Offset(, 1).Value
        Rws = Rng(1).Offset(, 2).End(xlDown).Row
        ReDim Arr(1 To Rws, 1 To 2)
        For J = 6 To Rws
            With Cells(J, "C")
                If CLng(Right(Cells(J, "C").Value, Len(Trim(MaDD)))) = MaDD Then
                    W = W + 1:                  Arr(W, 1) = .Value
                    Arr(W, 2) = .Offset(, 1).Value
                End If
            End With
        Next J
        [aa2].Resize(W, 2).Value = Arr():       [g1].Value = MaDD
        Randomize:                              MyColor = 34 + 9 * Rnd() \ 1
        [f2:f3].Interior.ColorIndex = MyColor
        [f2:f3].Font.ColorIndex = MyColor
    End If
 ElseIf Not Intersect(Target, [f2]) Is Nothing Then
    Set Rng = Range([e5], [e5].End(xlDown))
    For J = Len(Target.Value) To 1 Step -1
        If Mid(Target.Value, J, 1) >= "A" Then
            DD = Left(Target.Value, J):         Exit For
        End If
    Next J
    Set sRng = Rng.Find(DD)
    If Not sRng Is Nothing Then
        MaDD = sRng.Offset(, -1).Value:         [g2].Value = MaDD
    End If
    Rws = Rng(1).Offset(, 1).End(xlDown).Row
    ReDim Arr(1 To Rws, 1 To 2)
    For J = 6 To Rws
        With Cells(J, "f")
            If CLng(Right(Cells(J, "f").Value, Len(Trim(MaDD)))) = MaDD Then
                W = W + 1:                      Arr(W, 1) = .Value
                Arr(W, 2) = .Offset(, 1).Value
            End If
        End With
    Next J
    [ad2].Resize(W, 2).Value = Arr():           [f2].Font.ColorIndex = 3
    [f3].Font.ColorIndex = MyColor + 1:         [f3].Interior.ColorIndex = MyColor + 1
 ElseIf Not Intersect(Target, [f3]) Is Nothing Then
    [f3].Font.ColorIndex = 5
 End If
End Sub

 

[tueyennhi]

Cảm ơn tất cả anh chị em rất là nhiều!

 

[tueyennhi]

Có thể tham khảo file này lúc rỗi:

Mong rằng nó hữu ích tí xíu nào đó với bạn.

[Bổ sung tô màu cho lòe loẹt nè:]

Option Explicit
Dim MyColor As Byte
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Rng As Range, sRng As Range, Arr()
 Dim MaDD As Long, Rws As Long, J As Long, W As Integer
 Dim DD As String
  
 If Not Intersect(Target, [F1]) Is Nothing Then
    [ab1].CurrentRegion.Offset(1).ClearContents
    Set Rng = Range([A6], [A6].End(xlDown))
    Set sRng = Rng.Find(Target.Value, , xlFormulas, xlWhole)
    [ad2].CurrentRegion.Offset(1).ClearContents
    If Not sRng Is Nothing Then
        MaDD = sRng.Offset(, 1).Value
        Rws = Rng(1).Offset(, 2).End(xlDown).Row
        ReDim Arr(1 To Rws, 1 To 2)
        For J = 6 To Rws
            With Cells(J, "C")
                If CLng(Right(Cells(J, "C").Value, Len(Trim(MaDD)))) = MaDD Then
                    W = W + 1:                  Arr(W, 1) = .Value
                    Arr(W, 2) = .Offset(, 1).Value
                End If
            End With
        Next J
        [aa2].Resize(W, 2).Value = Arr():       [g1].Value = MaDD
        Randomize:                              MyColor = 34 + 9 * Rnd() \ 1
        [f2:f3].Interior.ColorIndex = MyColor
        [f2:f3].Font.ColorIndex = MyColor
    End If
 ElseIf Not Intersect(Target, [f2]) Is Nothing Then
    Set Rng = Range([e5], [e5].End(xlDown))
    For J = Len(Target.Value) To 1 Step -1
        If Mid(Target.Value, J, 1) >= "A" Then
            DD = Left(Target.Value, J):         Exit For
        End If
    Next J
    Set sRng = Rng.Find(DD)
    If Not sRng Is Nothing Then
        MaDD = sRng.Offset(, -1).Value:         [g2].Value = MaDD
    End If
    Rws = Rng(1).Offset(, 1).End(xlDown).Row
    ReDim Arr(1 To Rws, 1 To 2)
    For J = 6 To Rws
        With Cells(J, "f")
            If CLng(Right(Cells(J, "f").Value, Len(Trim(MaDD)))) = MaDD Then
                W = W + 1:                      Arr(W, 1) = .Value
                Arr(W, 2) = .Offset(, 1).Value
            End If
        End With
    Next J
    [ad2].Resize(W, 2).Value = Arr():           [f2].Font.ColorIndex = 3
    [f3].Font.ColorIndex = MyColor + 1:         [f3].Interior.ColorIndex = MyColor + 1
 ElseIf Not Intersect(Target, [f3]) Is Nothing Then
    [f3].Font.ColorIndex = 5
 End If
End Sub

Đáp ứng vượt cả mong muốn của mình. Tuyệt vời . Cảm ơn bạn nhé!