Lọc ra mã duy nhất theo điều kiện từ ngày đến ngày

[AnhThu-1976]

Em chào các anh/chị,
Các anh chị Giúp em code Lọc ra mã Hàng hóa duy nhất theo điều kiện từ ngày đến ngày như sau:
Dựa vào sheet DS
Em muốn lọc danh sách mã Hàng hóa duy nhất theo điều kiện từ ngày đến ngày (điều kiện từ ngày đến ngày ở ô H3 và F3 sheet KQ)
Kết quả điền vào sheet KQ từ B9 trở xuống
Em cảm ơn!

 

[BuiQuangThuan]

Kết quả điền vào sheet KQ từ B9 trở xuống

Dùng Advance Filter để làm cũng được

 

[AnhThu-1976]

Dùng Advance Filter để làm cũng được

Anh giúp làm code, để em có thể áp dụng cho các bài khác của em, em cảm ơn nhé!

 

[BuiQuangThuan]

Anh giúp làm code, để em có thể áp dụng cho các bài khác của em, em cảm ơn nhé!

Xin lỗi. Nếu chỉ lấy mã duy nhất. Thì advance không phù hợp. Hãy dùng pivotable có lẽ hợp lý hơn

 

[snow25]

Em chào các anh/chị,
Các anh chị Giúp em code Lọc ra mã Hàng hóa duy nhất theo điều kiện từ ngày đến ngày như sau:
Dựa vào sheet DS
Em muốn lọc danh sách mã Hàng hóa duy nhất theo điều kiện từ ngày đến ngày (điều kiện từ ngày đến ngày ở ô H3 và F3 sheet KQ)
Kết quả điền vào sheet KQ từ B9 trở xuống
Em cảm ơn!

Dùng dictionary duyệt là được mà.

 

[AnhThu-1976]

Dùng dictionary duyệt là được mà.

Anh làm giúp em, để em thử áp dụng file khác ạ!

 

[snow25]

Anh làm giúp em, để em thử áp dụng file khác ạ!

Bạn thử code.

Sub laygiatri()
    Dim i As Long, lr As Long, dic As Object, arr, kq, ngaybd As Long, ngaykt As Long
    Dim dk As String, a As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("DS")
         lr = .Range("B" & Rows.Count).End(xlUp).Row
         arr = .Range("B9:E" & lr).Value
         ReDim kq(1 To UBound(arr), 1 To 2)
    End With
    With Sheets("KQ")
         ngaybd = .Range("F3").Value2
         ngaykt = .Range("H3").Value2
         For i = 1 To UBound(arr)
             If CLng(arr(i, 1)) >= ngaybd And CLng(arr(i, 1)) <= ngaykt Then
                dk = arr(i, 3)
                If Not dic.exists(dk) Then
                   dic.Add dk, ""
                   a = a + 1
                   kq(a, 1) = arr(i, 3)
                   kq(a, 2) = arr(i, 4)
                End If
             End If
         Next i
         lr = .Range("B" & Rows.Count).End(xlUp).Row
         If lr > 8 Then .Range("B9:C" & lr).ClearContents
         If a Then .Range("B9:C9").Resize(a).Value = kq
     End With
     Set dic = Nothing
                  
End Sub

 

[Hai Lúa Miền Tây]

Em chào các anh/chị,
Các anh chị Giúp em code Lọc ra mã Hàng hóa duy nhất theo điều kiện từ ngày đến ngày như sau:
Dựa vào sheet DS
Em muốn lọc danh sách mã Hàng hóa duy nhất theo điều kiện từ ngày đến ngày (điều kiện từ ngày đến ngày ở ô H3 và F3 sheet KQ)
Kết quả điền vào sheet KQ từ B9 trở xuống
Em cảm ơn!

Bạn thử code sau nhé:

Sub LocNgay_HLMT()
    With CreateObject("ADODB.Connection")
        .Open ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No""")
        Sheet2.Range("B9").CopyFromRecordset .Execute("Select Distinct F3,F4 From [DS$B9:E] Where F1 Between #" & Format(Sheet2.Range("F3"), "yyyy-MM-dd") & "# And #" & Format(Sheet2.Range("H3"), "yyyy-MM-dd") & "#")
    End With
End Sub

 

[AnhThu-1976]

Em cảm ơn anh Snow25 và Anh Hai Lúa Miền Tây nhiều nhé!

 

[johnnylinhanh]

Xin lỗi. Nếu chỉ lấy mã duy nhất. Thì advance không phù hợp. Hãy dùng pivotable có lẽ hợp lý hơn

Mình thấy Advance Filter có nút check Unique Record Only mà bạn