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

[Kiều Mạnh]

To huypham Bạn bỏ bớt một cái With Sheet5 đi cho chung lên trên luôn cho nó gọn
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

 

[Hau151978]

Trong code của bạn huypham có khai báo Dim Hdk As Date và Hdk=Sheet2.[B1].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.

 

[Kiều Mạnh]

Trong code của bạn huypham có khai báo Dim Hdk As Date và Hdk=Sheet2.[B1].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()
    [A1] = Date
    [C1] = [A1].Value2
    [E1] = [A1].Value
End Sub

 

[tungtruong8924]

Xài 1 cột phụ (cột F tại sheet Tổng hợp nhé! (Công thức thì file đính kèm.)

Còn code thì thử cái này:

[GPECODE=vb]
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
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
[/GPECODE]

cảm ơn bạn đã chia sẻ, mình vừa làm được rồi, hi

 

[hpkhuong]

Cảm ơn các bác, mình áp dụng code của @giangleloi thấy chuẩn và đúng ý mình.
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

Ú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 D21000 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

 

[giangleloi]

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

 

[hpkhuong]

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

Hihihi. Đủ món ăn chơi......

 

[doveandrose]

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

 

[hpkhuong]

đã 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

Cũng có suy nghỉ như bác vậy. Tốn đất.......... Mà nếu không có đất cắm dùi thì biết để ở đâu? Bác gán trực tiếp vào Source như hình vẽ được không? Hay ta thử record thao tác này xem................hihi

 

[phihndhsp]

Cũng có suy nghỉ như bác vậy. Tốn đất.......... Mà nếu không có đất cắm dùi thì biết để ở đâu? Bác gán trực tiếp vào Source như hình vẽ được không? Hay ta thử record thao tác này xem................hihi

đừ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)

 

[hpkhuong]

đừ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

 

[doveandrose]

đừ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)

em chém gió chơi chứ thật ra em cũng đâu biết làm =))
nhưng em biết chắc 1 điều
khi topic này kết thúc thì hiểu biết của anh sẽ khác đi đấy =))

 

[phihndhsp]

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

 

[n0thing1988]

Chủ đề đang hay. Liệu có ai giải đáp được thắc mắc của thầy Phi ko?
Đặt gạch hóng tiếp

 

[giangleloi]

em chém gió chơi chứ thật ra em cũng đâu biết làm =))
nhưng em biết chắc 1 điều
khi topic này kết thúc thì hiểu biết của anh sẽ khác đi đấy =))

Và code nó ở đây ( Hic hic hic)

 

[huypham]

Code chuẩn luôn. Nhưng nên đặt tên là Hahaha

 

[phihndhsp]

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

 

[giangleloi]

Đú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

    For I = K To DONGCUOI
        TEM = Replace(TEM, ",,", ",")
    Next

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

 

[phihndhsp]

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

 

[hpkhuong]

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.
[GPECODE=vb]
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
[/GPECODE]

[GPECODE=vb]
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
[/GPECODE]