Code lọc dữ liệu trùng lặp theo điều kiện

[Anhduong2015]

Xin chào anh/chị
Nhờ anh/chị trên diễn đàn trợ giúp em đoạn code liên quan đến việc lọc dữ liệu trùng lặp theo điều kiện ngày và copy sang bảng báo cáo.
Các bước em đang làm thủ công là:
B1: Lọc dữ liệu cột ngày tháng sheet DATA theo điều kiện ô D3 Sheet KQ
B2: Copy toàn bộ cột Ngày tháng sheet DATA dán vào một vùng trống
B3: Sử dụng chức năng Remove Duplicates
B4: Copy sau đó Paste vào ô F4 Sheet KQ
Tuy nhiên việc này em làm rất mất thời gian nhờ các anh/chị trợ giúp em đoạn code để tiết kiệm thời gian và chính xác hơn
Em có gửi hình kèm theo file Demo đính kèm (file thực em rất nặng hơn 100.000 dòng)

Xin cám ơn.

 

[Anhduong2015]

Bạn thử sửa dòng:

If r Then .Range("F4").Resize(r) = WorksheetFunction.Transpose(dic.Keys)

thành:

If r Then .Range("F4") = Join(dic.Keys, ",") 'chú ý trên bảng tính F4 phải format kiểu text nếu nối các con số bởi dấu ","

Xin cám ơn anh/chị kết quả gần như mong đợi, tuy nhiên mình có thể sắp xếp được theo thứ tự từ bé đến lớn không ạ? cụ thể là: 160,326,327 (kết quả theo đoạn code là (327,326,160)

 

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

Xin cám ơn anh/chị kết quả gần như mong đợi, tuy nhiên mình có thể sắp xếp được theo thứ tự từ bé đến lớn không ạ? cụ thể là: 160,326,327 (kết quả theo đoạn code là (327,326,160)

Bạn thử lại đoạn code sau:

Option Explicit

Sub RemoveduplicatesAndSort_LSX()
    Dim data As Variant, Temp As Variant, sLSX As String, r As Long, i As Long, j As Long, iDate As Date, ca As Integer
    Dim dic As New Scripting.Dictionary 'Tools/References: "Microsoft Scripting Runtime"
    With ThisWorkbook.Worksheets("DATA")
        .AutoFilterMode = False
        r = .Range("C" & .Rows.Count).End(xlUp).Row
        If r < 8 Then
            MsgBox "Khong tim thay du lieu phu hop", vbCritical + vbOKOnly: Exit Sub
        End If
        data = .Range("C8:G" & r).Value
    End With
    With ThisWorkbook.Worksheets("KQ")
        iDate = .Range("D3"): ca = .Range("D4")
        .Range("F4").ClearContents
        .Range("F4").NumberFormat = "@"
        For r = LBound(data, 1) To UBound(data, 1)
            If data(r, 1) = iDate Then
                If data(r, 2) = ca Then
                    sLSX = data(r, 5)
                    If Not dic.Exists(sLSX) Then
                        dic.Add sLSX, iDate
                    End If
                End If
            End If
        Next r
        r = dic.Count
        If r = 0 Then
            MsgBox "Khong tim thay du lieu phu hop", vbCritical + vbOKOnly: Exit Sub
        End If
        ReDim data(0 To r - 1)
        For i = 0 To r - 1
            data(i) = dic.Keys(i)
        Next i
        If r = 1 Then GoTo ghiketqua_xuong_sheet
        For i = LBound(data) To UBound(data) - 1
           For j = i + 1 To UBound(data)
              If UCase(data(i)) > UCase(data(j)) Then
                 Temp = data(j)
                 data(j) = data(i)
                 data(i) = Temp
              End If
          Next j
        Next i
ghiketqua_xuong_sheet:
        .Range("F4") = Join(data, ",")
    End With
End Sub

 

[concogia]

Nếu dữ liệu đã được sắp xếp như trong bài ( cột [C} ) thì dù dữ liệu có là 100.000 dòng hay hơn nữa thì khi chạy code ta cũng chỉ làm việc với vài ngàn hay chục ngàn dòng thoả 2 điều kiện mà thôi, không lo chuyện code chạy ì ạch
Thân

 

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

Nếu dữ liệu đã được sắp xếp như trong bài ( cột [C} ) thì dù dữ liệu có là 100.000 dòng hay hơn nữa thì khi chạy code ta cũng chỉ làm việc với vài ngàn hay chục ngàn dòng thoả 2 điều kiện mà thôi, không lo chuyện code chạy ì ạch
Thân

Đúng rồi Bác ạ,mới đầu con cũng định có ý tưởng dùng sort trước tìm đến ngày theo điều kiện rồi chạy đến khi nó lớn hơn thì thoát vòng lặp.
Nhưng con không làm vì rút kinh nghiệm, trong chủ đề:

CẦN LẤY DỮ LIỆU GẦN NHẤT - XÓA CÁC DỮ LIỆU TRÙNG NHAU

Em chào anh/chị Anh/ chị giúp em: em có một file excel dữ liệu trùng nhau rất nhiều lần. Em muốn lấy dữ liệu ngày gần nhất và xóa các dữ liệu trùng nhau.Thanks all

www.giaiphapexcel.com

Không nên làm thay đổi đảo lộn dữ liệu gốc, bài này mà dùng sort từ đầu thì bài 22 còn gọn hơn nhiều ạ

 

[concogia]

Đúng rồi Bác ạ,mới đầu con cũng định có ý tưởng dùng sort trước tìm đến ngày theo điều kiện rồi chạy đến khi nó lớn hơn thì thoát vòng lặp.
Nhưng con không làm vì rút kinh nghiệm, trong chủ đề:

CẦN LẤY DỮ LIỆU GẦN NHẤT - XÓA CÁC DỮ LIỆU TRÙNG NHAU

Em chào anh/chị Anh/ chị giúp em: em có một file excel dữ liệu trùng nhau rất nhiều lần. Em muốn lấy dữ liệu ngày gần nhất và xóa các dữ liệu trùng nhau.Thanks all

www.giaiphapexcel.com

Không nên làm thay đổi đảo lộn dữ liệu gốc, bài này mà dùng sort từ đầu thì bài 22 còn gọn hơn nhiều ạ

Hai bài này dữ liệu và yêu cầu khác nhau mà bạn, bài trong "thớt" này chắc chắn dữ liệu đã được sắp xếp, còn bài kia tại bạn muốn gọn nên sort dữ liệu gốc của người ta, người ta hông la sao được. Híc
Bài này dùng MATCH kiếm NGÀY thoả điều kiện, chạy tới lúc không thoả điều kiện NGÀY thì thoát ra thôi, mình nghĩ vài ngàn dòng thì nhằm nhò gì
Thân

 

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

Hai bài này dữ liệu và yêu cầu khác nhau mà bạn, bài trong "thớt" này chắc chắn dữ liệu đã được sắp xếp, còn bài kia tại bạn muốn gọn nên sort dữ liệu gốc của người ta, người ta hông la sao được. Híc
Bài này dùng MATCH kiếm NGÀY thoả điều kiện, chạy tới lúc không thoả điều kiện NGÀY thì thoát ra thôi, mình nghĩ vài ngàn dòng thì nhằm nhò gì
Thân

Con làm thử theo gợi ý của Bác:

Sub DuLieuKhongNhamNhoGi()
    Dim data As Variant, Temp As Variant, sLSX As String, r As Long, k As Long, iDate As Long, ca As Integer
    Dim dic As New Scripting.Dictionary 'Tools/References: "Microsoft Scripting Runtime"
    With ThisWorkbook.Worksheets("DATA")
        .AutoFilterMode = False
        r = .Range("C" & .Rows.Count).End(xlUp).Row
        If r < 8 Then Exit Sub
        .Range("C7:R" & r).Sort key1:=.Range("C7"), order1:=xlAscending, Key2:=.Range("D7"), Order2:=xlAscending, Key3:=.Range("G7"), Order3:=xlAscending, Header:=xlYes
        iDate = ThisWorkbook.Worksheets("KQ").Range("D3")
        k = Application.Match(iDate, .Range("C8:C" & r), 0)
        data = .Range("C" & k & ":G" & r).Value
    End With
    With ThisWorkbook.Worksheets("KQ")
         ca = .Range("D4")
        .Range("F4").ClearContents
        .Range("F4").NumberFormat = "@"
        For r = LBound(data, 1) To UBound(data, 1)
            If data(r, 1) = iDate Then
                If data(r, 2) = ca Then
                    sLSX = data(r, 5)
                    If Not dic.Exists(sLSX) Then
                        dic.Add sLSX, iDate
                    End If
                End If
                If data(r, 2) <> ca Then Exit For
            End If
            If data(r, 1) > iDate Then Exit For
        Next r
        r = dic.Count
        If r = 0 Then Exit Sub
        .Range("F4") = Join(dic.Keys, ",")
    End With
End Sub

 

[concogia]

Hihi, mình không dám hướng dẫn hay gợi ý cho bạn viết đâu, vì mình không đủ trình độ để làm việc đó, mình cũng học viết code kiểu "giang hồ" thôi, Thầy của mình là tất cả anh chị em trên diễn đàn.
Thân

 

[Anhduong2015]

1. Chân thành cám ơn sự quan tâm và giúp đỡ nhiệt tình của anh/chị @Hoàng Nhật Phương và @concogia
2. Em đã chạy thử code trợ giúp của bài 22 và 26 thì kết quả đúng như mong đợi, về thời gian xử lý thì không quá chênh lệch còn theo kiến thức cá nhân non nớt thì em xem code #26 cảm thấy dễ hiểu hơn.
3. Thật sự rất trân quý sự nhiệt tình của tất cả anh/chị trên diễn đàn đặc biệt gửi lời cám ơn sâu sắc đến bạn @Hoàng Nhật Phương đã giúp đỡ em nhiệt tình trong bài này. Đồng thời cũng rất ngưỡng mộ kiến thức và sự khiêm tốn của anh/chị.
4. Qua đây em cảm thấy sự mạnh mẽ của mảng và Dictionary rất muốn được tìm hiểu, học hỏi nhờ các anh/chị nếu tiện xin giới thiệu giúp khóa học/tài liệu/link vài chủ đề trong diễn đàn GPE để em nắm nền tảng và từng bước học hỏi thực hành nhiều hơn.
Xin cám ơn !

 

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

1. Chân thành cám ơn sự quan tâm và giúp đỡ nhiệt tình của anh/chị @Hoàng Nhật Phương và @concogia
2. Em đã chạy thử code trợ giúp của bài 22 và 26 thì kết quả đúng như mong đợi, về thời gian xử lý thì không quá chênh lệch còn theo kiến thức cá nhân non nớt thì em xem code #26 cảm thấy dễ hiểu hơn.
3. Thật sự rất trân quý sự nhiệt tình của tất cả anh/chị trên diễn đàn đặc biệt gửi lời cám ơn sâu sắc đến bạn @Hoàng Nhật Phương đã giúp đỡ em nhiệt tình trong bài này. Đồng thời cũng rất ngưỡng mộ kiến thức và sự khiêm tốn của anh/chị.
4. Qua đây em cảm thấy sự mạnh mẽ của mảng và Dictionary rất muốn được tìm hiểu, học hỏi nhờ các anh/chị nếu tiện xin giới thiệu giúp khóa học/tài liệu/link vài chủ đề trong diễn đàn GPE để em nắm nền tảng và từng bước học hỏi thực hành nhiều hơn.
Xin cám ơn !

Bạn có thể tham khảo link: Index - Các bài viết về VBA

 

[truongvu317]

Application.Match(iDate, .Range("C8:C" & r), 0)

Nếu mình làm bài này mình sẽ dùng thêm hàm Countifs, cho nó đủ bộ âm dương.

 

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

Nếu mình làm bài này mình sẽ dùng thêm hàm Countifs, cho nó đủ bộ âm dương.

Mới đầu mình định tính theo cách này nhưng nếu đưa 'Countifs' vào nữa khi còn chậm hơn, vì dù sao đến khi không thỏa mãn điều kiện nữa thì code cũng tự thoát rồi mà nhỉ, hihi:

If data(r, 1) > iDate Then Exit For

 

[hoahuongduong1986]

Mới đầu mình định tính theo cách này nhưng nếu đưa 'Countifs' vào nữa khi còn chậm hơn, vì dù sao đến khi không thỏa mãn điều kiện nữa thì code cũng tự thoát rồi mà nhỉ, hihi:

If data(r, 1) > iDate Then Exit For

Chị OT chưa bao giờ làm em thất vọng !hi

 

[truongvu317]

Mới đầu mình định tính theo cách này nhưng nếu đưa 'Countifs' vào nữa khi còn chậm hơn, vì dù sao đến khi không thỏa mãn điều kiện nữa thì code cũng tự thoát rồi mà nhỉ, hihi:

If data(r, 1) > iDate Then Exit For

Đúng rồi, code có thêm phần check điều kiện sẽ chặt chẽ chạy nhanh.