Lọc duy nhất ? (1 người xem)

[Hoàng Nhật Phương]

Xin chào tất cả các bạn,
Thời gian trước O.Thơ có tìm hiểu trên diễn đàn phương pháp sử dụng code để lọc duy nhất.
Cụ thể O.Thơ muốn lọc dữ liệu từ cột C đến cột I dữ liệu duy nhất được đưa vào cột J.
Và O.Thơ đã sử dụng bình thường nhưng đến thời điểm này thì code bị lỗi.
O.Thơ không biết xử lý thế nào nên gửi nên đây để nhờ các bạn giúp đỡ.


Rất mong nhận được sự trợ giúp của các bạn,
Trân trọng cảm ơn.

 

[eke_rula]

Xin chào các bạn,
Tôi đang vướng mắc về vấn lọc dữ liệu theo điều kiện (cụ thể nêu trong sheet3 của file kèm), tôi đã loay hoay suốt hàng giờ đồng mà không biết code như thế nào.
Nên up lên đây nhờ các bạn giúp đỡ các bạn giúp đỡ cho ạ:
Hic, do hết dung lượng đưa file trực tiếp lên diễn đàn,vì vậy Oanh Thơ gửi file vào đây ạ: (T_T)
https://secufiles.com/4Lm8/loc_(1).xlsb

Phiền các bạn xem và giúp đỡ cho ạ.

Dữ liệu của bạn nhiều quá, bạn có thể dùng CT mảng này tại G6:

G6=INDEX(Sheet1!D:D,SMALL(IF(Sheet1!$M$5:$M$66444>=Sheet3!$H$2,IF(Sheet1!$M$5:$M$66444<=Sheet3!$J$2,ROW(Sheet1!$D$5:$D$66444))),ROW(A1)))

Fill sang phải, rồi fill xuống dưới rồi đợi khoảng ... 2 phút!!!
Bài này nhờ các anh chị khác viết VBA cho bạn sẽ hay hơn, chạy bằng CT nặng!!!

 

[Hoàng Nhật Phương]

Dữ liệu của bạn nhiều quá, bạn có thể dùng CT mảng này tại G6:

G6=INDEX(Sheet1!D:D,SMALL(IF(Sheet1!$M$5:$M$66444>=Sheet3!$H$2,IF(Sheet1!$M$5:$M$66444<=Sheet3!$J$2,ROW(Sheet1!$D$5:$D$66444))),ROW(A1)))

Fill sang phải, rồi fill xuống dưới rồi đợi khoảng ... 2 phút!!!
Bài này nhờ các anh chị khác viết VBA cho bạn sẽ hay hơn, chạy bằng CT nặng!!!

Hi, cảm ơn eke_rula rất nhiều,
Bạn nhiệt tình thật đó đêm đã khuya mà bạn vẫn còn vào diễn đàn để giúp đỡ mọi người ^^
Với cách sử dụng bằng công thức của bạn nêu trên tôi sẽ lưu lại để vẫn dụng trong trường hợp tập tin ít dữ liệu.
Còn với bài này của tôi dữ liệu thực gần 150k dòng rồi bạn ạ,bởi vì dữ liệu update liên tục theo năm tháng, nên muốn có giải pháp bằng vba bạn ạ hic (_ _)

 

[Hoang2013]

Tôi vướng về lọc dữ liệu theo điều kiện (cụ thể nêu trong sheet3 của file kèm), tôi đã loay hoay suốt hàng giờ đồng mà không biết code như thế nào. . . .

Option Explicit
Sub LocKhoangTG()
 Dim Arr()
 Dim Rws As Long, J As Long, W As Long, fDat As Date, lDat As Date, Tmr As Double
 
 Tmr = Timer()
  With Sheet1.[d5]  
    Rws = .CurrentRegion.Rows.Count
    Arr() = .Resize(Rws, 10).Value
  End With    
 ReDim dArr(1 To Rws, 1 To 2) As String
 With Sheet3
    fDat = .[h2].Value:             lDat = .[j2].Value
    For J = 1 To UBound(Arr())
        If Arr(J, 10) >= fDat And Arr(J, 10) <= lDat Then
            W = W + 1:              dArr(W, 1) = Arr(J, 1)
            dArr(W, 2) = Arr(J, 2)
        End If
    Next J
'    If W Then  '
        .[g6].Resize(J, 2).Value = dArr()
        .[j4] = Timer() - Tmr
'    End If     '
 End With 
End Sub

 

[Hoàng Nhật Phương]

Option Explicit
Sub LocKhoangTG()
 Dim Arr()
 Dim Rws As Long, J As Long, W As Long, fDat As Date, lDat As Date, Tmr As Double
 
 Tmr = Timer()
  With Sheet1.[d5]  
    Rws = .CurrentRegion.Rows.Count
    Arr() = .Resize(Rws, 10).Value
  End With    
 ReDim dArr(1 To Rws, 1 To 2) As String
 With Sheet3
    fDat = .[h2].Value:             lDat = .[j2].Value
    For J = 1 To UBound(Arr())
        If Arr(J, 10) >= fDat And Arr(J, 10) <= lDat Then
            W = W + 1:              dArr(W, 1) = Arr(J, 1)
            dArr(W, 2) = Arr(J, 2)
        End If
    Next J
'    If W Then  '
        .[g6].Resize(J, 2).Value = dArr()
        .[j4] = Timer() - Tmr
'    End If     '
[COLOR=#ff0000][B].[G5:H100000].RemoveDuplicates Columns:=1, header:=xlYes[/B][/COLOR]
 End With 
End Sub

Cảm bạn Hoang2013 đã hỗ trợ ạ.
Về tiêu đề tôi sẽ lưu ý.
về code tôi đã thử kết quả rất OK và code chạy rất nhanh, cảm ơn bạn rất nhiều.
----
Xin hỏi bạn thêm 1 vấn đề nữa liên quan đến bài toán lọc duy nhất ạ:

Do file thực tại cột D của sheet1 là danh sách các mã hàng được cập nhật theo các ngày trong tháng nên sẽ có rất nhiều mã hàng trùng nhau.
Vì vậy code trên của bạn tôi có bổ sung thêm dòng màu đỏ để xóa các dữ liệu trùng nhau tại cột G6:H theo cột G.
Nhưng với dòng code này sẽ xóa đi hết các định dạng của các cell.

Rất mong bạn giúp đỡ cho tôi thêm 1 cách khác để thay thế cho dòng màu đỏ trên.

 

[Hoang2013]

Vì code trên của bạn tôi có bổ sung thêm dòng màu đỏ để xóa các dữ liệu trùng nhau tại cột G6:H theo cột G.
Nhưng với dòng code này sẽ xóa đi hết các định dạng của các cell.

Rất mong bạn giúp đỡ cho tôi thêm 1 cách khác để thay thế cho dòng màu đỏ trên.

Không phải dòng Code đó xóa định dạng của bạn đâu, đừng nghĩ oan cho nó.

Macro làm cái công việc nạp dữ liệu từ mảng lên 2 cột trang tính thì định dạng thế nào trước đó nó vẫn bảo lưu mà.

(Hay mình chưa rõ í của bạn, không biết nữa?)

 

[Hoàng Nhật Phương]

Không phải dòng Code đó xóa định dạng của bạn đâu, đừng nghĩ oan cho nó.

Macro làm cái công việc nạp dữ liệu từ mảng lên 2 cột trang tính thì định dạng thế nào trước đó nó vẫn bảo lưu mà.

(Hay mình chưa rõ í của bạn, không biết nữa?)

Xin chào Hoang2013

Ý tôi là cái dòng này, mà tôi thêm vào:

.[G5:H100000].RemoveDuplicates Columns:=1, header:=xlYes

nó sẽ xóa đi các định dạng bạn ah.

Mong muốn bạn hướng dẫn một giải pháp khác thay cho sử dụng RemoveDuplicates ạ.

 

[befaint]

Do file thực tại cột D của sheet1 là danh sách các mã hàng được cập nhật theo các ngày trong tháng nên sẽ có rất nhiều mã hàng trùng nhau.

Sub LocMot()
Dim DL As Variant, z As Long, r As Long, KQ() As Variant, j As Long
Dim d1 As Long, d2 As Long, D As Variant, tmp As Variant
Dim Dic As Object: Set Dic = CreateObject("Scripting.Dictionary")
d1 = CLng(Sheet3.Range("H2").Value2): d2 = CLng(Sheet3.Range("J2").Value2)
With Sheet1
    .AutoFilterMode = False
    z = .Range("D" & .Rows.Count).End(xlUp).Row
    DL = .Range("D5:M" & z).Value2: z = UBound(DL, 1)
    ReDim KQ(1 To z, 1 To 2)
    For r = 1 To z
        D = DL(r, 10)
        If D <> Empty Then
            D = CLng(D)
            If d1 <= D And D <= d2 Then
                tmp = DL(r, 1)
                If tmp <> Empty And Not Dic.Exists(tmp) Then
                    Dic.Add tmp, ""
                    j = j + 1
                    KQ(j, 1) = tmp: KQ(j, 2) = DL(r, 2)
                End If
            End If
        End If
    Next r
End With
If j Then
    Sheet3.Range("G6").Resize(100000, 2).ClearContents
    Sheet3.Range("G6").Resize(j, 2) = KQ
End If
End Sub

p/s: Có thể upload file lên trang khác được không? Link bài #20 toàn quảng cáo...

 

[Hoàng Nhật Phương]

Sub LocMot()
Dim DL As Variant, z As Long, r As Long, KQ() As Variant, j As Long
Dim d1 As Long, d2 As Long, D As Variant, tmp As Variant
Dim Dic As Object: Set Dic = CreateObject("Scripting.Dictionary")
d1 = CLng(Sheet3.Range("H2").Value2): d2 = CLng(Sheet3.Range("J2").Value2)
With Sheet1
    .AutoFilterMode = False
    z = .Range("D" & .Rows.Count).End(xlUp).Row
    DL = .Range("D5:M" & z).Value2: z = UBound(DL, 1)
    ReDim KQ(1 To z, 1 To 2)
    For r = 1 To z
        D = DL(r, 10)
        If D <> Empty Then
            D = CLng(D)
            If d1 <= D And D <= d2 Then
                tmp = DL(r, 1)
                If tmp <> Empty And Not Dic.Exists(tmp) Then
                    Dic.Add tmp, ""
                    j = j + 1
                    KQ(j, 1) = tmp: KQ(j, 2) = DL(r, 2)
                End If
            End If
        End If
    Next r
End With
If j Then
    Sheet3.Range("G6").Resize(100000, 2).ClearContents
    Sheet3.Range("G6").Resize(j, 2) = KQ
End If
End Sub

p/s: Có thể upload file lên trang khác được không? Link bài #20 toàn quảng cáo...

Cảm ơn befaint rất nhiều, kết quả ưng quá rồi bạn ạ.
Vâng được ạ,Oanh Thơ sẽ lưu ý!

 

[Nguyễn Duy Tuân]

Công thức tạo danh sách duy nhất với hàm BS_Unique, sắp xếp, tạo NAME trong Excel

LỌC DANH SÁCH DUY NHẤT VỚI HÀM BS_UNIQUE() - DÀNH CHO NHỮNG BẠN KHÔNG QUAN TÂM TỚI LẬP TRÌNH VBA - CHỈ DÙNG HÀM!
Từ một vùng dữ liệu, lấy danh sách duy nhất, danh sách được sắp xếp tăng/giảm dần là một việc rất khó khi làm công thức Excel. Với Add-in A-Tools bạn chỉ cần một hàm BS_UNIQUE. Danh sách duy nhất cho phép co giãn dòng, đặt NAME bao dữ liệu tự động để tương tác với công cụ Excel khác như Validation - List,...

[video=youtube;eCzEN0ckN0w]https://www.youtube.com/watch?v=eCzEN0ckN0w[/video]​