Lọc mảng nhiều điều kiện

11 Responses

1. hands says:

   25/02/2023 at 2:56 pm

   Bạn copy CT này vào ô D4 sau đó kéo sang, xuống cho các ô còn lại nhé:

   =IFERROR(OFFSET('TONG HOP'!$A$1,SMALL(IF('TONG HOP'!$A$2:$A$9='CHI TIET'!$B$1,IF('TONG HOP'!$D$2:$D$9='CHI TIET'!$B$2,MATCH('TONG HOP'!$B$2:$B$9,'TONG HOP'!$B$2:$B$9,0),"")),ROW(1:1)),MATCH(A$3,'TONG HOP'!$A$1:$E$1,0)-1),"")

   Bạn kết thúc bằng CTRL+SHIFT+ENTER

   Reply
2. hands says:

   25/02/2023 at 2:59 pm

   Hix. cảm ơn bác. Giờ đã hiểu mình sai ngay đoạn ElseIf hixxx………

   Sub Loc()
   Dim Sh As Worksheet, Arr(), zArr()
   Dim Rws As Long, J&, W&, dk1 As Date, dk2 As String
       dk1 = Sheets("CHI TIET").[B1].Value
       dk2 = Sheets("CHI TIET").[B2].Value
   zArr = Array(2, 3, 5)
       Set Sh = Sheets("TONG HOP")
       With Sh.[A2]
           Rws = .CurrentRegion.Rows.Count
           Arr() = .Resize(Rws, 5).Value
       End With
       ReDim dArr(1 To Rws, 1 To 3)
       For J = 1 To UBound(Arr())
           If Arr(J, 1) = dk1 And Arr(J, 4) = dk2 Then
               W = 1 + W
               For Z = 0 To UBound(zArr)
                   dArr(W, Z + 1) = Arr(J, zArr(Z))
               Next Z
           ElseIf Arr(J, 4) = dk2 And dk1 = Empty Then
               W = 1 + W
               For Z = 0 To UBound(zArr)
                   dArr(W, Z + 1) = Arr(J, zArr(Z))
               Next Z
           ElseIf Arr(J, 1) = dk1 And dk2 = Empty Then
               W = 1 + W
               For Z = 0 To UBound(zArr)
                   dArr(W, Z + 1) = Arr(J, zArr(Z))
               Next Z
           End If
       Next J
       If W Then
           Sheets("CHI TIET").[A4].Resize(65000, 3).ClearContents
           Sheets("CHI TIET").[A4].Resize(W, 3).Value = dArr()
       End If
   End Sub

   mình chậm chạm nên chỉ kịp ghi có 1 dòng . huhu

   If (Arr(I, 1) = dk1 Or dk1 = Empty) And (Arr(I, 4) = dk2 Or dk2 = Empty) Then

   Reply
3. hands says:

   25/02/2023 at 3:12 pm

   Cảm ơn các bác, mình áp dụng code của @giangleloi thấy chuẩn và đúng ý mình.

   Sub Loc()
   Dim Arr(), Hp(1 To 10000, 1 To 3), I As Long, J As Long, K As Long
   Dim DK As String, Hdk As Date
       With Sheet1
           Arr = .Range(.[A3], .[A65000].End(3)).Resize(, 5).Value
       End With
         Hdk = Sheet2.[B1].Value2
         DK = Sheet2.[B2].Value
           For I = 1 To UBound(Arr, 1)
                 If Arr(I, 1) = Hdk And Arr(I, 4) = DK Then
                   K = K + 1
                   Hp(K, 1) = Arr(I, 2)
                   Hp(K, 2) = Arr(I, 3)
                   Hp(K, 3) = Arr(I, 5)
                ElseIf Arr(I, 4) = DK And Hdk = Empty Then
                   K = K + 1
                   Hp(K, 1) = Arr(I, 2)
                   Hp(K, 2) = Arr(I, 3)
                   Hp(K, 3) = Arr(I, 5)
                ElseIf Arr(I, 1) = Hdk And DK = Empty Then
                   K = K + 1
                   Hp(K, 1) = Arr(I, 2)
                   Hp(K, 2) = Arr(I, 3)
                   Hp(K, 3) = Arr(I, 5)
             End If
           Next
       With Sheet2
           .[A4:C10000].ClearContents
            If K Then .[A4].Resize(K, 3) = Hp
       End With
   End Sub

   Mình bắt chước code này để thêm code lọc danh sách NCC, chưa triệt để nhưng thấy ok rồi.

   Sub LOCNCC()Dim Arr(), Hp(1 To 10000, 1 To 3), I As Long, J As Long, K As Long
   Dim Hdk As Date
       With Sheet1
           Arr = .Range(.[A3], .[A65000].End(3)).Resize(, 5).Value
       End With
           Hdk = Sheet2.[B1].Value2
       For I = 1 To UBound(Arr, 1)
           If Arr(I, 1) = Hdk Then
               K = K + 1
               Hp(K, 1) = Arr(I, 4)
           End If
       Next
           With Sheet5
           .[A2:A10000].ClearContents
            If K Then .[A2].Resize(K, 1) = Hp
           End With
           With Sheet5
           .[A2:A10000].RemoveDuplicates Columns:=1, Header:=xlNo
           End With
   End Sub

   Trong code của bạn huypham có khai báo Dim Hdk As Date và Hdk=Sheet2..Value2
   Theo mình đã khai báo kiểu Date thì nên dùng Value, tuy ở trường hợp này code chạy đúng nhưng bạn không nên lẫn lộn value và value2. Value2 chuyển đổi giá trị Date sang Number nhưng do Hdk có kiểu Date rồi nên Number lại được chuyển về kiểu Date, còn Value sẽ giữ nguyên kiểu Date.

   Thấy bạn nói lại nhớ hôm Anh hải qua chỉ code Value & Value2……….Giờ mình thật sự hiểu Value Và Value2…………Cảm ơn Bạn

   Sub Value_Value2()
   = Date
   = .Value2
   = .Value
   End Sub

   Úi……lọc duy nhất chỗ này mà chế Code phụ thuộc vào điều kiện ngày tại cell B1 chi cho rồi mắt vậy bạn. Sao không làm động tác copy cột D2:D1000 sheet tổng hợp ra sheet khác (hình như là sheet5 bạn mới thêm). Sau đó dùng RemoveDuplicates cho khỏe…
   (đằng nào cũng phải lấy hết danh sách các nhà cung cấp, nên cứ làm vầy cho khỏe, khỏi phải nghĩ suy.)
   Chỉ đơn giản là: (

   Sub LOCNCC()
       Sheet3.[A2:A1000] = Sheets("TONG HOP").Range("D2:D1000").Value
       Sheet3.[A2:A1000].RemoveDuplicates Columns:=1, Header:=xlNo
   End Sub

   Còn Source của Data valation (cell B2 sheet chi tiết). thì bạn đặt cho vùng A2:A1000 của sheet mới vừa thêm (sheet5) này một cái name động là được, có bao nhiêu mã NCC thì nó tự lấy rồi

   Name động làm list cho Source:

   =OFFSET([COLOR=#ff0000][B]Sheet1!$A$2,[/B][/COLOR],,COUNTA([COLOR=#ff0000]Sheet1!$A$2[/COLOR]:$A$1000))

   Sheet1!$A$2: màu đỏ này bạn chỉnh cho đúng tên sheet thực tế mới thêm của bạn

   Thế thì xài code để tạo Name luôn. Kiểu như thế này nè:

   Sub LOCNCC()
   Dim Rng As Range
     Sheet1.Columns(4).Copy: Sheet3.[D1].PasteSpecial xlPasteValues
       With Sheet3
         .Columns(4).RemoveDuplicates Columns:=1, Header:=xlYes
         Set Rng = .Range("D2:D" & .Range("D" & Rows.Count).End(3).Row)
       ActiveWorkbook.Names.Add "NCC", Rng
       End With
   End Sub

   đã dùng code mà còn bị tốn 1 vùng trên sheet để lưu danh sách (tấc đất tấc vàng), rồi tốn thêm 1 named để đặt tên cho cái vùng đó nữa => chưa đi đến bến bờ ăn chơi )(&&@@)(&&@@)(&&@@

   có cách nào thực hiện bằng code đúng như hình vẽ #10 không ta ? List Source hiện lên chính xác
   NCC1,NCC2,NCC3

   Reply
4. hands says:

   25/02/2023 at 3:13 pm

   đừng tìm nữa? không có cách nào đâu, phải thông qua cái name thì mới được(theo như hiểu biết của tôi)

   Mới thử Record,

   Sub Macro1()
       Range("B2").Select
       With Selection.Validation
           .Delete
           .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
           xlBetween, Formula1:[COLOR=#ff0000][B]="NCC1,NCC2,NCC3"[/B][/COLOR]
           .IgnoreBlank = True
           .InCellDropdown = True
           .InputTitle = ""
           .ErrorTitle = ""
           .InputMessage = ""
           .ErrorMessage = ""
           .ShowInput = True
           .ShowError = True
       End With
   End Sub

   Vấn đề là có được cái vùng đỏ đỏ ấy là tôi nghỉ có thể được………..
   1. Copy dữ liệu gốc
   2. Dán vào vùng tạm
   3. Remove Dup
   4. Nối lại như mãng trên
   5. Đưa vào source như record ở trên
   6. Xóa vùng tạm
   Kết thúc sub

   Ý tưởng là vậy, ai làm để học hỏi đi……….hihihi

   Reply
5. hands says:

   25/02/2023 at 3:15 pm

   cũng hy vọng là vậy. vì trước đây mấy năm tôi cũng hỏi mà chưa có câu trả lời cho validation lấy từ nguồn dữ liệu ra duy nhất
   Đúng là có người bàn và vấn đề đã ra, không cần tạo name, đúng là 1 nhóm người cùng suy nghĩ có khác
   sửa lại code bài 35 một tí, dùng dic lấy duy nhất sau đó đưa vào trong validation

   Public Sub LIST()
   Dim Dic As Object, Arr(), I As Long, TEM As String, K As Long
   Dim rng As Range
       Application.ScreenUpdating = False
       Set Dic = CreateObject("Scripting.Dictionary")
       DONGCUOI = Sheet1.Range("D65000").End(xlUp).Row
       Set rng = Sheet1.Range("D2:D" & DONGCUOI)
       ReDim Arr(1 To DONGCUOI)
       For I = 1 To DONGCUOI - 1
                  TEM = rng(I, 1)
               If Not Dic.Exists(TEM) Then
                   K = K + 1
                   Dic.Add TEM, K
                   Arr(K) = rng(I, 1).Value
               End If
       Next I
       TEM = Join(Arr, ",")
       For I = K To DONGCUOI
           TEM = Replace(TEM, ",,", ",")
       Next
       TEM = Left(TEM, Len(TEM) - 1)
       With Selection.Validation
           .Delete
           .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
           xlBetween, Formula1:=TEM
       End With
           Application.ScreenUpdating = true
   End Sub

   Em cũng làm theo hướng của anh luôn rồi. Nhưng cố đợi anh chàng cao siêu đó hỏi "đểu" nữa. "Người ấy" không phải dạng vừa. Hình như đoạn trên đấy không cần anh nhỉ? Chỉ vô Source mới thấy. Bên ngoài thì đâu ảnh hưởng )(&&@@

   Nếu chỉ Add mỗi cái Validation thì xài code sau đi cho nó gọn

   Public Sub DicAdd_Validation()
   Dim dl(), i As Long, Dic As Object
   dl = Range(, .End(3)).Value
   Set Dic = CreateObject("scripting.dictionary")
   For i = 1 To UBound(dl)
   Dic(dl(i, 1)) = ""
   Next
   Range("G2").Validation.Delete
   Range("G2").Validation.Add 3, , , Join(Dic.keys, ",")
   Set Dic = Nothing
   End Sub

   Reply
6. hands says:

   25/02/2023 at 3:15 pm

   Vì chưa xác định chiều dài của mảng một chiều nên tôi lấy chiều dài dài nhất, và khi dùng hàm join nó sẽ thêm nhiều dấu ,,, nên cần xử lý những chuỗi ,, lại

   Các bác cao siêu quá, toàn DIC to DIC nhỏ, mình mới học code, nghỉ sao viết vậy.

   Sub LNCC()
   Dim Rng As Range, Sou As String
       With Sheet1
           .Columns(4).Copy: .[H1].PasteSpecial xlPasteValues
           .Columns(8).RemoveDuplicates Columns:=1, Header:=xlYes
       Set Rng = .Range("H2:H" & .Range("H" & Rows.Count).End(3).Row)
       Sou = Mid(noi(Rng), 2, Len(noi(Rng)))
       End With
       With Selection.Validation
           .Delete
           .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
           xlBetween, Formula1:=Sou
       End With
       Sheet1.Range("H1:H10000").ClearContents
   End Sub

   Function noi(vung As Range)
   Dim i, kq
   Set vung = Sheet1.Range("H2:H" & Sheet1.Range("H" & Rows.Count).End(3).Row)
      For i = 1 To vung.Rows.Count
         If vung(i, 1) <> "" Then
            kq = kq & "," & vung(i, 1)
         End If
      Next i
   noi = kq
   End Function

   Reply
7. hands says:

   25/02/2023 at 3:16 pm

   nhìn phần chữ kí của anh chắc là anh ít xài Dic nên mới nghĩ và làm thế . còn anh nhìn chữ kí của em chắc cũng biết em thích tắm cái giếng nào . hihi . đâu cần phải khỗ vậy . nhờ anh và các bạn ở trên giúp đỡ , em mới nghĩ ra được cách này . cám ơn các bạn

   Public Sub hello()
   Dim Dic As Object, Arr As Variant, lr As Long, r As Long
       Application.ScreenUpdating = False
       Set Dic = CreateObject("Scripting.Dictionary")
       lr = WorksheetFunction.Max(Sheet1.Range("D65000").End(xlUp).Row, 2)
       Arr = Sheet1.Range("D2:D" & lr).Value
       If IsArray(Arr) Then
           For r = 1 To lr - 1
               If WorksheetFunction.Trim(Arr(r, 1)) <> "" Then Dic(Arr(r, 1)) = 1
           Next
       Else
           If WorksheetFunction.Trim(Arr) <> "" Then Dic(Arr) = 1
       End If
       Sheet1.Range("G2").ClearContents
       With Sheet1.Range("G2").Validation
           .Delete
           If Dic.Count > 0 Then
               .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
               xlBetween, Formula1:=Join(Dic.keys(), ",")
           End If
       End With
       Application.ScreenUpdating = True
   End Sub

   Tám một tẹo
   hình như Bạn cũng mê Dic giống mình thì phải …..có thì cứ lôi ra mà xài đi cho sướng vậy cất dấu để rành mằn chi ….khổ quá đi mất..–=0–=0

   cái đó đương nhiên rồi . em đoán là chức năng remove Duplicate của excel cũng hoạt động theo nguyên tắc này .
   khi các bạn từng thử nghiệm lấy danh sách duy nhất với cỡ khoảng hàng trăm nghìn mã số khác nhau thì có lẽ các bạn sẽ dẹp bỏ được ý nghĩ : lấy danh sách không trùng mà không cần dùng Dic hoặc chức năng remove duplicate
   còn anh nữa : bài viết của anh có 4 chữ số rồi sao vẫn các ngôi sao quay đều vậy ? phải bao nhiêu bài viết mới được 1 sao đứng im vậy ?

   Reply
8. hands says:

   25/02/2023 at 3:16 pm

   Thêm 1 cách không xài DIC nè:

   Sub List_HICHICHIC()
   Application.ScreenUpdating = False
   Dim Lr As Long, Str As String, I As Long
     With Sheet1
       Lr = .Range("D" & Rows.Count).End(xlUp).Row
       For I = 2 To Lr
          If .Application.WorksheetFunction.CountIf(.Range("D2:D" & I), .Range("D" & I)) = 1 Then
                Str = Str & "," & .Range("D" & I)
           End If
       Next
       With .[G2].Validation
           .Delete
           .Add 3, , ,Str
       End With
    End With
   Application.ScreenUpdating = True
   End Sub

   Reply
9. hands says:

   25/02/2023 at 3:17 pm

   Công nhân đề tài này xôm tụ thiệt.

   Vẫn vụ tạo data validation
   Nhưng bây giờ làm cho cell B1, (file của chủ topic), làm sao để đưa vào format dd/mm/yyyy trong code luôn.
   Lấy cột A2 trở đi làm dữ liệu nguồn. Và khi code thì format như nào để được dạng Source: 23/06/2015,26/06/2015,29/06/2015

   Thử code mà toàn nó đưa vào list là Value của dạng ngày …….hixxhixx

   Ý BẠN LÀ đưa ngày vào Validation phải ko nếu vậy thì code sau
   mình mới đổi lại kiểu With CreateObject("scripting.dictionary")

   Public Sub Dic_Validation()
   Dim Arr(), i As Long
   Arr = Range("A2", .End(3)).Value
   With CreateObject("scripting.dictionary")
   For i = 1 To UBound(Arr)
   .Item(Arr(i, 1)) = ""
   '.Item(Arr(i, 1)) = .Count
   Next
   Range("G2").Validation.Delete
   Range("G2").Validation.Add 3, , , Join(.keys, ",")
   End With
   End Sub

   Bạn có thể tham khảo thêm ở link sau
   https://www.giaiphapexcel.com/forum/showthread.php?84045-C%C3%A1ch-l%C3%A0m-Kh%C3%B4ng-c%C3%B3-%C3%B4-tr%E1%BB%91ng-trong-Data-Validation-settings-list-Source/page3

   https://www.giaiphapexcel.com/forum/showthread.php?84205-H%E1%BB%8Fi-v%E1%BB%81-Data-Validation/page3

   Reply
10. hands says:

    25/02/2023 at 3:17 pm

    Cách mọi người đang làm hình như sẽ thỉnh thoảng bị lỗi khi đóng file rồi mở file lên.
    Trước đây mình từng bị nên sau này không dùng Validation nữa.
    Dùng cách khác cũng cho ra kết quả tương tự nhưng code có thể ngắn hơn nhiều. Cứ thử nghiên cứu thêm cách khác nha.
    Chứ xem đoạn code ngắn tí tẹo của mình thì mất hứng suy nghĩ.

    Tặng cho thớt này một kiểu nữa nè tha hồ mà lựa….Tui nhớ trước đây có thành viên dị ứng với Dic To Dic Thon keo tui ko biết Dic giờ tui viết các kiểu cho mà coi.. nha–=0–=0–=0

    Public Sub Date_Validation()
    Dim dl(), i As Long
    dl = Range(, .End(3)).Value
    With CreateObject("scripting.dictionary")
    For i = 1 To UBound(dl)
    If Not .Exists(dl(i, 1)) Then .Item(dl(i, 1)) = .Count
    Next
    .Validation.Delete
    .Validation.Add 3, , , Join(.keys, ",")
    End With
    End Sub

    Thử sửa dòng này

    If Not .Exists(dl(i, 1)) Then .Item(dl(i, 1)) = .Count

    Thành dòng này xem coi có chết ai không. Viết chi dài lê thê vậy?

    .Item(dl(i, 1)) = ""

    Oh.
    1. Trường hợp đầu khi Dim Dic As Object, rồi Set Dic = ….. : như vậy nó làm cho dữ liệu ngày thành Value
    2. Trường hợp code ở Quote bên trên: With CreateObject("scripting.dictionary"). Mà không cần Dim hay Set thì định dạng ngày nó lại không thay đổi.

    Lý do tại sao như vậy nhỉ? Mong bác giải thích giúp!-0-/.

    bạn cho tôi trường hợp bạn gặp phải đi? vì tôi thấy không có sự khác biệt nào?
    khai báo Dim rồi Set thì sẽ tường minh hơn (trong trường hợp sử dụng nhiều nơi)
    còn sử dụng ít thì có thể tạo trực tiếp Create…., còn về dữ liệu thì nó như nhau không có khác biệt gì

    Oh. Mới test lại code DIC, đúng thật là nó ra dạng ngày luôn. không hiểu sao hồi lúc test nó lại ra value mới ghê.hixhix……..
    Nếu không dùng DIC (mấy code không phải DIC ở topic này) nếu áp dụng ngày thì có để nguyên định dạng đưa vào Validation không anh? nếu được anh làm thử cho cái tham khảo nha!

    Reply
11. hands says:

    25/02/2023 at 3:17 pm

    Không sử dụng DIC

    Sub GPE()
        Dim Rng As Range
        Dim ArrD()
        Dim ArrN()
        Dim DongCuoi As Long
        Dim i As Long, j As Long
        Dim DongHienTai As Long
        DongCuoi = Sheet1.Range("A60000").End(xlUp).Row
        ArrN = Sheet1.Range("A2:A" & DongCuoi)
         ReDim ArrD(1)
         ArrD(1) = ArrN(1, 1)
         DongHienTai = 1
         flag = True
        For i = 1 To UBound(ArrN, 1)
            For j = 1 To DongHienTai
                 If (ArrN(i, 1) = ArrD(j)) Then
                   flag = False
                   Exit For
                 End If
            Next j
                If (flag = True) Then
                    DongHienTai = DongHienTai + 1
                     ReDim Preserve ArrD(DongHienTai)
                    ArrD(DongHienTai) = ArrN(i, 1)
                End If
                flag = True
         Next
         Range("G3").Validation.Delete
         Range("G3").Validation.Add xlValidateList, , , Join(ArrD, ",")
    End Sub

    Quan trọng là cái chỗ mình đặt nó đang định dạng là kiểu gì thôi mà?

    Giờ đã hiểu lý do. Do dùng vùng tạm để gán dữ liệu đang định dạng là General …….(mà không để ý) nên khi nối lại khi code & đưa vào source…..nó ra value luôn! hixxhixx

    Reply