Lọc duy nhất nhiều điều kiện? (1 người xem)

[Miền Cát Trắng]

Xin chào tất cả mọi người,
Em đang gặp phải bài toán khó khăn như đã nêu trong file kèm.
Xin phép gửi lên đây để mọi người tìm cách giúp đỡ ạ.
Em xin cảm ơn.

 

[dhn46]

Code thì bạn tham khảo nhé

Sub Loc()
    Dim Dic As Object
    Dim i As Long, j As Long, k As Long
    Dim Tmp As String
    Dim Arr, Res
    Arr = [F8:I13]
    ReDim Res(1 To UBound(Arr, 1), 1 To UBound(Arr, 2))
    Set Dic = CreateObject("Scripting.Dictionary")
    With Dic
        For i = 1 To UBound(Arr, 1)
            Tmp = Arr(i, 1) & "#" & Arr(i, 2) & "#" & Arr(i, 3)
            If Not .Exists(Tmp) Then
                k = k + 1
                .Add Tmp, k
                For j = 1 To UBound(Arr, 2)
                    Res(k, j) = Arr(i, j)
                Next
            Else
                Res(.Item(Tmp), 4) = Res(.Item(Tmp), 4) + Arr(i, 4)
            End If
        Next
    End With
    Range("L8").Resize(k, UBound(Arr, 2)) = Res
End Sub

 

[SA_DQ]

Thêm 1 macro vừa tầm nè, mại zô!

Option Explicit
Sub GPE()
 Dim Rng As Range, sRng As Range, Cls As Range
 Dim MyAdd$, Rws&
 
 Rws = [f8].CurrentRegion.Rows.Count
 With [e7]
    Union(.Resize(Rws), [m8].CurrentRegion).Clear
    .Value = "GPE.COM"
 End With
 For Each Cls In Range([e8], [f8].End(xlDown).Offset(, -1))
    With Cls
        .Value = Right("000" & .Offset(, 1).Value, 4) & _
            Right("000" & CStr(.Offset(, 2).Value), 4) & Right("000" & CStr(.Offset(, 3).Value), 4)
    End With
 Next Cls
 Set Rng = [e8].CurrentRegion
 Rng.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("L7:p7"), Unique:=True
 [p8].Resize(Rws).Value = ""
 Set Rng = [e7].Resize(Rws)
 For Each Cls In Range([L8], [L8].End(xlDown))
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        MyAdd = sRng.Address
        Do
            Cls.Offset(, 4).Value = Cls.Offset(, 4).Value + sRng.Offset(, 4).Value
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    End If
 Next Cls
 Union([e7].Resize(Rws), [l7].Resize(Rws)).Clear
End Sub

 

[Miền Cát Trắng]

Kết quả thật tuyêt em xin cảm ơn GPE nhiều ạ.
-----------
Em xin hỏi bài toán này có thể dùng công thức được không ạ, nếu có xin GPE cho em ví dụ cụ thể ạ.
Em xin cảm ơn nhiều.

 

[Miền Cát Trắng]

Công thức gì nữa bạn? công thức thì tôi đã nói ở #2, sao không tìm hiểu rồi làm thử. Topic của mình, ai trả lời cũng rán đọc hết..........xem đó là gì...............thì mới tiến bộ được chứ! cứ không biết lại.........đi hỏi.............trả lời cho rồi.............mà không làm thì cũng bằng không!

Hi, bạn minh xin lỗi vì mình không nói rõ
ý mình muốn nói là làm sao để không sử dụng cả công cụ Data/Remove Duplicates nữa bạn à
Cách của bạn mình đã thử quả thật mình đã biết thêm được về tính năng này.
Rất cảm ơn bạn đã giúp đỡ.

 

[Let'GâuGâu]

Kết quả thật tuyêt em xin cảm ơn GPE nhiều ạ.
-----------
Em xin hỏi bài toán này có thể dùng công thức được không ạ, nếu có xin GPE cho em ví dụ cụ thể ạ.
Em xin cảm ơn nhiều.

Cách thì có nhiều cách, tính hiệu quả thì tìm cái nào ngắn nhất, nhanh nhất mà đi
nhưng nhiều khi cũng để cho tâm hồn nó bay bổng..........hhihihih

L9=INDEX($F$8:$H$13,MATCH(0,INDEX(COUNTIFS($L$7:$L7,$F$8:$F$13,$M$7:$M7,$G$8:$G$13,$N$7:$N7,$H$8:$H$13),),0),[COLOR=#ff0000]1[/COLOR])

cột 1 số 1, cột 2 số và cột.......3 tức là........số 3

 

[ChanhTQ@]

P/s: mà sao không hiểu cái đơn giản nhất, nhẹ nhất thì lại không thích làm nhỉ..........cứ đòi bằng được cái nặng nhất mới chịu!

Nhẹ với bạn thôi, với người khác như mình thì công thức là chuyện rất ư là nặng nề!