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

Anhduong2015 · 29/7/21

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.

Hoàng Nhật Phương · 29/7/21

Anhduong2015 đã viết:
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)
View attachment 263268
Xin cám ơn.

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

Mã:

Option Explicit
Sub LSX_No()
    Dim data(), r As Long, iDate As Date, dic As Object, sLSX As String
    Set dic = CreateObject("Scripting.Dictionary")
    With ThisWorkbook.Worksheets("DATA")
        .AutoFilterMode = False
        data = .Range("C6").CurrentRegion.Value
    End With
    With ThisWorkbook.Worksheets("KQ")
        iDate = .Range("D3")
        For r = 3 To UBound(data, 1)
            If data(r, 1) = iDate Then
                sLSX = data(r, 5)
                If Len(sLSX) <> Empty And Not dic.Exists(sLSX) Then dic.Add sLSX, iDate
            End If
        Next r
        r = dic.Count
        .Range("F4").Resize(100000).ClearContents
        If r Then .Range("F4").Resize(r) = WorksheetFunction.Transpose(dic.Keys)
    End With
End Sub

Ba Tê · 29/7/21

Hoàng Nhật Phương đã viết:

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

Mã:

Option Explicit
Sub LSX_No()
    Dim data(), r As Long, iDate As Date, dic As Object, sLSX As String
    Set dic = CreateObject("Scripting.Dictionary")
    With ThisWorkbook.Worksheets("DATA")
        .AutoFilterMode = False
        data = .Range("C6").CurrentRegion.Value
    End With
    With ThisWorkbook.Worksheets("KQ")
        iDate = .Range("D3")
        For r = 3 To UBound(data, 1)
            If data(r, 1) = iDate Then
                sLSX = data(r, 5)
                If Len(sLSX) <> Empty And Not dic.Exists(sLSX) Then dic.Add sLSX, iDate
            End If
        Next r
        r = dic.Count
        .Range("F4").Resize(100000).ClearContents
        If r Then .Range("F4").Resize(r) = WorksheetFunction.Transpose(dic.Keys)
    End With
End Sub

Híc! Cái này dùng Advanced Filter, code "gọn hơ".
Không biết với 100 ngàn dòng như tác giả nói có chạy được không.

PHP:

Sub GPE()
    Sheets("DATA").Range("C6", Sheets("DATA").Range("G1000000").End(xlUp)).AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Range("D2:D3"), CopyToRange:=Range("F3"), Unique:=True
End Sub

Hoàng Nhật Phương · 29/7/21

Híc,Thầy để con 'tỏa sáng' một tẹo chứ $-\\/.$

Hoàng Tuấn 868 · 29/7/21

Hoàng Nhật Phương đã viết:
tỏa sáng' một tẹo chứ $-\\/.$

Như đèn pha rồi bạn ơi.

Ba Tê · 29/7/21

Hoàng Nhật Phương đã viết:
Híc,Thầy để con 'tỏa sáng' một tẹo chứ $-\\/.$

Tôi đâu có "tắt đèn" đâu, bạn cứ tỏa sáng thôi.

Hoàng Tuấn 868 · 29/7/21

Ba Tê đã viết:
Tôi đâu có "tắt đèn" đâu, bạn cứ tỏa sáng thôi.

Không tắt đèn, nhưng em đoán anh chỉ định thổi nến thôi.

Hoàng Nhật Phương · 29/7/21

Ba Tê đã viết:
Tôi đâu có "tắt đèn" đâu, bạn cứ tỏa sáng thôi.

Dạ, vì "đèn" của Thầy sáng quá nên "đèn" của con không nhận ra luôn ấy ạ }}}}}

Hai Lúa Miền Tây · 30/7/21

Anhduong2015 đã viết:
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)
View attachment 263268
Xin cám ơn.

Thêm 1 cách cho bạn tham khảo:

Mã:

Sub LayDL_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("F4:F100").ClearContents
        Sheet2.Range("F4").CopyFromRecordset .Execute("Select Distinct F5 From [Data$C8:G] Where F1 = #" & Format(Sheet2.Range("D3"), "yyyy-MMM-dd") & "#")
    End With
End Sub

Ngoài ra bạn có thể dùng PivotTable để lấy dữ liệu duy nhất nhé.

Anhduong2015 · 30/7/21

Lời đầu tiên em xin gửi lời cám ơn chân thành đến tất cả các anh/chị đã quan tâm đến bài viết và giúp đỡ nhiệt tình.
Tuy nhiên có một số điều em còn đang vướng hoặc chưa rõ xin phép được trình bày thêm
1. Bài trợ giúp của anh/chị @Hoàng Nhật Phương kết quả đúng như em mong đợi tuy nhiên nếu được cho em hỏi thêm số 1 có ý nghĩa là gì để e học thêm kiến thức.

2. Bài trợ giúp của anh/chị @Ba Tê code rất đơn giản và dễ hiểu tuy nhiên khi em run thì nó lấy luôn dòng tiêu đề là số 5, thông tin này em để hiển thị cột và không muốn lấy và LSX ạ, đồng thời em mong muốn chỉ Paste Value không cần phải Paste cả định dạng.

3. Bài trợ giúp của anh/chị @Hai Lúa Miền Tây thì em run bị lỗi Open có thể là máy em còn thiếu cài đặt gì đó cũng rất mong anh/chị hướng dẫn thêm đồng thời em cũng xin cám ơn gợi ý về cách sử dụng PivotTable để lấy dữ liệu duy nhất

Hai Lúa Miền Tây · 30/7/21

Anhduong2015 đã viết:
Lời đầu tiên em xin gửi lời cám ơn chân thành đến tất cả các anh/chị đã quan tâm đến bài viết và giúp đỡ nhiệt tình.
Tuy nhiên có một số điều em còn đang vướng hoặc chưa rõ xin phép được trình bày thêm
1. Bài trợ giúp của anh/chị @Hoàng Nhật Phương kết quả đúng như em mong đợi tuy nhiên nếu được cho em hỏi thêm số 1 có ý nghĩa là gì để e học thêm kiến thức.

View attachment 263306
2. Bài trợ giúp của anh/chị @Ba Tê code rất đơn giản và dễ hiểu tuy nhiên khi em run thì nó lấy luôn dòng tiêu đề là số 5, thông tin này em để hiển thị cột và không muốn lấy và LSX ạ, đồng thời em mong muốn chỉ Paste Value không cần phải Paste cả định dạng.
View attachment 263307
3. Bài trợ giúp của anh/chị @Hai Lúa Miền Tây thì em run bị lỗi Open có thể là máy em còn thiếu cài đặt gì đó cũng rất mong anh/chị hướng dẫn thêm đồng thời em cũng xin cám ơn gợi ý về cách sử dụng PivotTable để lấy dữ liệu duy nhất
View attachment 263310

Báo lỗi tại dòng nào bạn?

Hoàng Nhật Phương · 30/7/21

Anhduong2015 đã viết:
Lời đầu tiên em xin gửi lời cám ơn chân thành đến tất cả các anh/chị đã quan tâm đến bài viết và giúp đỡ nhiệt tình.
Tuy nhiên có một số điều em còn đang vướng hoặc chưa rõ xin phép được trình bày thêm
1. Bài trợ giúp của anh/chị @Hoàng Nhật Phương kết quả đúng như em mong đợi tuy nhiên nếu được cho em hỏi thêm số 1 có ý nghĩa là gì để e học thêm kiến thức.

View attachment 263306

Tôi giải thích theo cách hiểu của mình có thể dùng từ không được chính xác, bạn tham khảo nhé:

Mã:

Option Explicit

Sub LSX_No()
    Dim data(), r As Long, iDate As Date, dic As Object, sLSX As String ' khai bao bien (tham so)de truyen du lieu
    Set dic = CreateObject("Scripting.Dictionary") 'Khoi tao Dic tudien(chi chap nhan gia tri dua vao phai duy nhat)
    With ThisWorkbook.Worksheets("DATA")
        .AutoFilterMode = False 'Bo filter
        data = .Range("C6").CurrentRegion.Value ' gan du lieu tren bang tinh vao mang data
        'Bat dau tu cot c(1) den cot R(16)
    End With
    With ThisWorkbook.Worksheets("KQ")
        iDate = .Range("D3")
        'LBound(data, 1): gioi han duoi cua mang data = 1
        'UBound(data, 1): gioi han duoi cua mang data = 786 (hieu theo cach khac la so dong du lieu)
        For r = LBound(data, 1) + 2 To UBound(data, 1)
        'du lieu se bat dau chay tu LBound(data, 1)=1 +2 = 3 (chay tu dong 3 tuong ung voi dong 8 tren bang tinh)
        ' r bat dau chay tu 3 den 786
            If data(r, 1) = iDate Then ' neu cot 1 = ngay can loc
                sLSX = data(r, 5) ' cot 5 LSX_So
                If Len(sLSX) <> Empty Then ' chi chap nhan gia tri LSX_So <> rong
                    If Not dic.Exists(sLSX) Then 'kiem tra neu gia LSX_So da co trong tu dien DIC hay chua
                        dic.Add sLSX, iDate 'Neu gia tri LSX_So chua ton tai trong Dic thi dua vao trong Dic
                    End If
                End If
            End If
        Next r
        r = dic.Count 'dem so gia tri duoc dua vao dic
        .Range("F4").Resize(100000).ClearContents ' xoa du lieu cu tu F4 den 100K dong
        ' neu trong dic co gia tri (r> 0), ghi tat ca cac gia tri xuong sheet tu F4
        If r Then .Range("F4").Resize(r) = WorksheetFunction.Transpose(dic.Keys)
        'dic.Keys la kieu du lieu mang 1 chieu (kieu giong nhu A1,B1,C1...)
        ' muon xoay lai dang A1,A2,A3 thi phai dung Transpose
    End With
End Sub

Anhduong2015 · 30/7/21

Hoàng Nhật Phương đã viết:
Tôi giải thích theo cách hiểu của mình có thể dùng từ không được chính xác, bạn tham khảo nhé:

Chân thành cám ơn bạn đã giúp đỡ và hướng dẫn tận tình có thể mình chưa hiểu hết nhưng sẽ lưu lại để thực hành và mài mò nghiên cứu thêm, về mảng và Dictionary mình tự học mãi mà vẫn chưa hiểu rõ được. Chúc bạn và gia đình nhiều sức khỏe.

Bài đã được tự động gộp: 30/7/21

Hai Lúa Miền Tây đã viết:
Báo lỗi tại dòng nào bạn?

Dạ ở ngay dòng Open ạ.

Hai Lúa Miền Tây · 30/7/21

Anhduong2015 đã viết:
Chân thành cám ơn bạn đã giúp đỡ và hướng dẫn tận tình có thể mình chưa hiểu hết nhưng sẽ lưu lại để thực hành và mài mò nghiên cứu thêm, về mảng và Dictionary mình tự học mãi mà vẫn chưa hiểu rõ được. Chúc bạn và gia đình nhiều sức khỏe.

Bài đã được tự động gộp: 30/7/21

Dạ ở ngay dòng Open ạ.

Bạn chép code của tôi vào file bạn gửi trên bài 1 hay là bạn chạy với file khác?

Anhduong2015 · 30/7/21

Hai Lúa Miền Tây đã viết:
Bạn chép code của tôi vào file bạn gửi trên bài 1 hay là bạn chạy với file khác?

Dạ chép vào file bài 1 ạ.

truongvu317 · 30/7/21

Anhduong2015 đã viết:
Dạ chép vào file bài 1 ạ.

Code đó muốn lấy 100k dòng thì cần phát triển thêm

be_09 · 31/7/21

Anhduong2015 đã viết:
..................................
2. Bài trợ giúp của anh/chị @Ba Tê code rất đơn giản và dễ hiểu tuy nhiên khi em run thì nó lấy luôn dòng tiêu đề là số 5, thông tin này em để hiển thị cột và không muốn lấy và LSX ạ, đồng thời em mong muốn chỉ Paste Value không cần phải Paste cả định dạng.
View attachment 263307

Nếu nó lấy luôn dòng tiêu đề là số 5, thì thử thêm dòng code này vào cuối cùng (code của Ba Tê).

Mã:

Sheet2.Range("F4").Delete Shift:=xlUp

Anhduong2015 · 31/7/21

be_09 đã viết:
Nếu nó lấy luôn dòng tiêu đề là số 5, thì thử thêm dòng code này vào cuối cùng (code của Ba Tê).

Mã:

Sheet2.Range("F4").Delete Shift:=xlUp

Dạ vâng xin cám ơn anh đã hướng dẫn.

Anhduong2015 · 31/7/21

Từ đoan code trợ giúp của anh/chị @Hoàng Nhật Phương theo yêu cầu sử dụng em có tinh chỉnh lại là:
1. Bổ sung lọc thêm một điều kiện là ca tổng cộng có 02 điều kiện là ngày tháng và ca.
2. Báo cáo theo dạng dòng thay cho dạng cột bỏ hàm Transpose.
Tuy nhiên em mong muốn chỉ điền các giá trị vào 01 ô phân cách nhau bởi dấu phẩy và sắp xếp từ bé đến lớn nhưng không biết sử dụng code như thế nào vì vậy hy vọng tiếp tục nhận được sự quan tâm và giúp đỡ từ tất cả anh/chị.
Em có gửi lại file cập nhật

Hoàng Nhật Phương · 31/7/21

Anhduong2015 đã viết:
Từ đoan code trợ giúp của anh/chị @Hoàng Nhật Phương theo yêu cầu sử dụng em có tinh chỉnh lại là:
1. Bổ sung lọc thêm một điều kiện là ca tổng cộng có 02 điều kiện là ngày tháng và ca.
2. Báo cáo theo dạng dòng thay cho dạng cột bỏ hàm Transpose.
Tuy nhiên em mong muốn chỉ điền các giá trị vào 01 ô phân cách nhau bởi dấu phẩy và sắp xếp từ bé đến lớn nhưng không biết sử dụng code như thế nào vì vậy hy vọng tiếp tục nhận được sự quan tâm và giúp đỡ từ tất cả anh/chị.
Em có gửi lại file cập nhật
View attachment 263379

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

Mã:

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

thành:

Mã:

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 ","

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

Thành viên chính thức

File đính kèm

Thành viên gắn bó

Cạo Rồi Khỏi Gội

File đính kèm

Thành viên gắn bó

Đăng ký hôm qua

Cạo Rồi Khỏi Gội

Đăng ký hôm qua

Thành viên gắn bó

❆❆❆❆❆❆❆❆

Thành viên chính thức

❆❆❆❆❆❆❆❆

Thành viên gắn bó

Thành viên chính thức

❆❆❆❆❆❆❆❆

Thành viên chính thức

Thành viên tích cực

Biên Hòa, Đồng Nai

Thành viên chính thức

Thành viên chính thức

File đính kèm

Thành viên gắn bó