Xin hướng dẫn Code VBA hàm Countif dữ liệu lớn trăm ngàn dòng

Hugo Nguyen · 9/10/20

Xin chào mọi người!
Mình có một bảng dữ liệu DATA lớn (800000 dòng) chứa thông tin giao dịch, cột A đến cột F, bây giờ mình muốn đếm những giao dịch có ngày, quốc gia, tỉnh, mã đơn và sale trùng nhau, sau đó xuất ra bảng chỉ chứa những dòng trùng như sheet "KET QUA".
Mình viết hàm cho nó chạy thì chạy không nổi, mong mọi người giúp đỡ viết giùm mình code VBA.
Xin cảm ơn mọi người.

VetMini · 9/10/20

Làm việc với dữ liệu kiểu này thì chịu khó học Power Query và Power Pivot.
Chứ chẳng lẽ cứ dựa vào mỗi bước lại nhờ người ta viết code giùm mình.

Hugo Nguyen · 9/10/20

VetMini đã viết:
Làm việc với dữ liệu kiểu này thì chịu khó học Power Query và Power Pivot.
Chứ chẳng lẽ cứ dựa vào mỗi bước lại nhờ người ta viết code giùm mình.

Vâng mình có dùng Power Pivot để xử lý những phân tích liên quan, nhưng do mình đang làm cái này cần phải dùng hàm hoặc VBA xử lý nên mới lên đây hỏi ạ, vì số dòng trùng cũng không nhiều nên mong mọi người có thể giúp mình bước này, còn xử lý sau đó thì mình có thể tự xử lý ạ.

snow25 · 9/10/20

Hugo Nguyen đã viết:
Xin chào mọi người!
Mình có một bảng dữ liệu DATA lớn (800000 dòng) chứa thông tin giao dịch, cột A đến cột F, bây giờ mình muốn đếm những giao dịch có ngày, quốc gia, tỉnh, mã đơn và sale trùng nhau, sau đó xuất ra bảng chỉ chứa những dòng trùng như sheet "KET QUA".
Mình viết hàm cho nó chạy thì chạy không nổi, mong mọi người giúp đỡ viết giùm mình code VBA.
Xin cảm ơn mọi người.

Bạn thử code.

Mã:

Sub laydulieu()
    Dim arr, i As Long, lr As Long, kq, a As Long, dic As Object, j As Integer, b As Integer, dk As String
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("data")
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         arr = .Range("A2:F" & lr).Value
         ReDim kq(1 To UBound(arr), 1 To 8)
         For i = 1 To UBound(arr)
             dk = arr(i, 2) & " " & arr(i, 4) & " " & arr(i, 5) & " " & arr(i, 3) & " " & arr(i, 6)
             If Not dic.exists(dk) Then
                a = a + 1
                dic.Add dk, a
                For j = 1 To 6
                    kq(a, j) = arr(i, j)
                Next j
                    kq(a, 7) = dk
                    kq(a, 8) = 1
             Else
                b = dic.Item(dk)
                kq(b, 8) = kq(b, 8) + 1
             End If
        Next i
   End With
   With Sheets("ket qua")
        lr = .Range("A" & Rows.Count).End(xlUp).Row
        If lr > 2 Then .Range("A2:H" & lr).ClearContents
        If a Then .Range("A2:H2").Resize(a).Value = kq
   End With
End Sub

VetMini · 9/10/20

Hugo Nguyen đã viết:
Vâng mình có dùng Power Pivot để xử lý những phân tích liên quan, nhưng do mình đang làm cái này cần phải dùng hàm hoặc VBA xử lý nên mới lên đây hỏi ạ, vì số dòng trùng cũng không nhiều nên mong mọi người có thể giúp mình bước này, còn xử lý sau đó thì mình có thể tự xử lý ạ.

Power Query có khả năng xử lý cái bạn cần.
Hàm sử dụng với Data Model rất hiệu quả. Một triệu dòng hoàn toàn nằm trong tầm vực của Data Model.

Nhattanktnn · 9/10/20

Hugo Nguyen đã viết:
Xin chào mọi người!
Mình có một bảng dữ liệu DATA lớn (800000 dòng) chứa thông tin giao dịch, cột A đến cột F, bây giờ mình muốn đếm những giao dịch có ngày, quốc gia, tỉnh, mã đơn và sale trùng nhau, sau đó xuất ra bảng chỉ chứa những dòng trùng như sheet "KET QUA".
Mình viết hàm cho nó chạy thì chạy không nổi, mong mọi người giúp đỡ viết giùm mình code VBA.
Xin cảm ơn mọi người.

Mình chỉ làm đếm trùng, còn tách dữ liệu lấy trùng hay không trùng thì bạn làm nhé(duyệt cột H=1 hoặc khác 1 đưa qua)

PHP:

Sub DemTrung()
Dim dic As Object, i&, j&, Lr&, sArr(), dArr(), Tmp$
With Sheets("Data")
Lr = .Range("A" & Rows.Count).End(xlUp).Row
If Lr = 1 Then Exit Sub
.Range("G2:H" & Lr).ClearContents
sArr = .Range("A2:F" & Lr).Value
ReDim dArr(1 To UBound(sArr, 1), 1 To 2)
Set dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(sArr)
    Tmp = Format(sArr(i, 2), "yyyy-mm-dd") & "_" & sArr(i, 4) & "_" & sArr(i, 5) & "_" & sArr(i, 3) & "_" & sArr(i, 6)
    dArr(i, 1) = Tmp
    dic.Item(Tmp) = dic.Item(Tmp) + 1
Next
For j = 1 To UBound(dArr)
    dArr(j, 2) = dic.Item(dArr(j, 1))
Next
.Range("G2").Resize(UBound(dArr), 2) = dArr
End With
End Sub

snow25 · 9/10/20

Nhattanktnn đã viết:
For j = 1 To UBound(dArr)
dArr(j, 2) = dic.Item(dArr(j, 1))
Next

Sao không đếm trùng luôn trong quá trình duyệt lần 1 mà cần phải duyệt thêm 1 vòng lặp nữa nhỉ bạn.

Nhattanktnn · 9/10/20

snow25 đã viết:
Sao không đếm trùng luôn trong quá trình duyệt lần 1 mà cần phải duyệt thêm 1 vòng lặp nữa nhỉ bạn.

Em nghĩ đếm số lượng bằng dic.item, mà do lần đầu duyệt chưa biết dic.item lớn nhất là bao nhiêu nên phải duyệt lại.
Bác sửa lại em tham khảo với

SA_DQ · 9/10/20

Loại bài này nên đăng ở đây: https://www.giaiphapexcel.com/diendan/forums/lập-trình-với-excel.79/

snow25 · 9/10/20

Nhattanktnn đã viết:
Em nghĩ đếm số lượng bằng dic.item, mà do lần đầu duyệt chưa biết dic.item lớn nhất là bao nhiêu nên phải duyệt lại.
Bác sửa lại em tham khảo với

Mình viết code bài 4 đó bạn xem.

snow25 · 9/10/20

SA_DQ đã viết:
Loại bài này nên đăng ở đây: https://www.giaiphapexcel.com/diendan/forums/lập-trình-với-excel.79/

Cháu chào Bác Sa nhé.

Nhattanktnn · 9/10/20

snow25 đã viết:
Mình viết code bài 4 đó bạn xem.

Em đã chạy code nhưng dường như không đúng ý đồ chủ thớt

Bài đã được tự động gộp: 9/10/20

Em thấy là kiểm tra tồn tại, nếu tồn tại rồi (tức trùng) mới trích ra sheet kết quả mà bác

snow25 · 9/10/20

Nhattanktnn đã viết:
Em đã chạy code nhưng dường như không đúng ý đồ chủ thớt

Khác chỗ nào nhỉ bạn.Để mình xem lại.

.

Nhattanktnn · 9/10/20

snow25 đã viết:
Khác chỗ nào nhỉ bạn.Để mình xem lại..

Chủ thớt muốn sheet data thể hiện mã và số lượng trùng, sheet kết quả lọc ra những mã nào đang bị trùng, số lượng trùng là bao nhiêu. Còn code bác em đọc qua thì hình như là trích xuất loại trùng

Hoàng Nhật Phương · 9/10/20

OT cũng thấy bài hay nên cũng tham gia hóng hớt

...
Ơ..ơ! thấy giống #4 hehe, người viết sau ăn trộm của người viết trước (xóa vì trùng) ^_^

snow25 · 9/10/20

Nhattanktnn đã viết:
Em đã chạy code nhưng dường như không đúng ý đồ chủ thớt

Bài đã được tự động gộp: 9/10/20

Em thấy là kiểm tra tồn tại, nếu tồn tại rồi (tức trùng) mới trích ra sheet kết quả mà bác

Đây bạn xem code nhé lúc nãy không đọc hết.

Mã:

Sub laydulieu()
    Dim arr, i As Long, lr As Long, kq, a As Long, dic As Object, j As Integer, b As Integer, dk As String, c As Integer
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("data")
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         arr = .Range("A2:F" & lr).Value
         ReDim kq(1 To UBound(arr), 1 To 8)
         For i = 1 To UBound(arr)
             dk = arr(i, 2) & " " & arr(i, 4) & " " & arr(i, 5) & " " & arr(i, 3) & " " & arr(i, 6)
             If Not dic.exists(dk) Then
                dic.Add dk, Array(0, 0)
             End If
             b = dic.Item(dk)(0) + 1
             c = dic.Item(dk)(1)
              dic.Item(dk) = Array(b, c)
             If b = 2 Then
                a = a + 1
                For j = 1 To 6
                    kq(a, j) = arr(i, j)
                Next j
                    kq(a, 7) = dk
                    kq(a, 8) = 2
                dic.Item(dk) = Array(b, a)
             ElseIf b > 2 Then
                kq(c, 8) = kq(c, 8) + 1
             End If
        Next i
   End With
   With Sheets("ket qua")
        lr = .Range("A" & Rows.Count).End(xlUp).Row
        If lr > 2 Then .Range("A2:H" & lr).ClearContents
        If a Then .Range("A2:H2").Resize(a).Value = kq
   End With
End Sub

excel_lv1.5 · 9/10/20

Hugo Nguyen đã viết:
Xin chào mọi người!
Mình có một bảng dữ liệu DATA lớn (800000 dòng) chứa thông tin giao dịch, cột A đến cột F, bây giờ mình muốn đếm những giao dịch có ngày, quốc gia, tỉnh, mã đơn và sale trùng nhau, sau đó xuất ra bảng chỉ chứa những dòng trùng như sheet "KET QUA".
Mình viết hàm cho nó chạy thì chạy không nổi, mong mọi người giúp đỡ viết giùm mình code VBA.
Xin cảm ơn mọi người.

Dùng Data model xử lý, trả kết quả table, đã thử với 1tr dòng nhanh hơn VBA dùng Dictionary rất nhiều (load full table còn nhanh hơn), chuột phải vào Table refresh bấm (file 1tr Dic xử lý tầm 4p, data model xử lý chưa tới 1p)

Hugo Nguyen · 9/10/20

VetMini đã viết:
Power Query có khả năng xử lý cái bạn cần.
Hàm sử dụng với Data Model rất hiệu quả. Một triệu dòng hoàn toàn nằm trong tầm vực của Data Model.

Vâng, xin cảm ơn góp ý của bạn nhé!

Bài đã được tự động gộp: 9/10/20

SA_DQ đã viết:
Loại bài này nên đăng ở đây: https://www.giaiphapexcel.com/diendan/forums/lập-trình-với-excel.79/

Vâng em là thành viên mới, lần sau đăng bài em sẽ chú ý hơn ạ, cảm ơn bác

Bài đã được tự động gộp: 9/10/20

Xin cảm ơn sự trợ giúp của mọi người rất nhiều ạ ^^

snow25 · 9/10/20

Hugo Nguyen đã viết:
Xin chào mọi người!
Mình có một bảng dữ liệu DATA lớn (800000 dòng) chứa thông tin giao dịch, cột A đến cột F, bây giờ mình muốn đếm những giao dịch có ngày, quốc gia, tỉnh, mã đơn và sale trùng nhau, sau đó xuất ra bảng chỉ chứa những dòng trùng như sheet "KET QUA".
Mình viết hàm cho nó chạy thì chạy không nổi, mong mọi người giúp đỡ viết giùm mình code VBA.
Xin cảm ơn mọi người.

Bạn thử code này nhé.

Mã:

Sub laydulieu()
    Dim arr, i As Long, lr As Long, kq, a As Long, dic As Object, j As Integer, b As Integer, dk As String, c As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("data")
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         arr = .Range("A2:F" & lr).Value
         ReDim kq(1 To UBound(arr), 1 To 8)
         For i = 1 To UBound(arr)
             dk = arr(i, 2) & " " & arr(i, 4) & " " & arr(i, 5) & " " & arr(i, 3) & " " & arr(i, 6)
             If Not dic.exists(dk) Then
                dic.Add dk, Array(0, i)
             End If
             b = dic.Item(dk)(0) + 1
             c = dic.Item(dk)(1)
             dic.Item(dk) = Array(b, c)
             If b = 2 Then
                 a = a + 1
                For j = 1 To 6
                    kq(a, j) = arr(c, j)
                Next j
                kq(a, 7) = dk
                a = a + 1
                For j = 1 To 6
                    kq(a, j) = arr(i, j)
                Next j
                    kq(a, 7) = dk
             ElseIf b > 2 Then
                a = a + 1
                For j = 1 To 6
                    kq(a, j) = arr(i, j)
                Next j
                    kq(a, 7) = dk
             End If
        Next i
        For i = 1 To a
            kq(i, 8) = dic.Item(kq(i, 7))(0)
        Next i
   End With
   With Sheets("ket qua")
        lr = .Range("A" & Rows.Count).End(xlUp).Row
        If lr > 2 Then .Range("A2:H" & lr).ClearContents
        If a Then .Range("A2:H2").Resize(a).Value = kq
   End With
End Sub

Hugo Nguyen · 9/10/20

snow25 đã viết:

Bạn thử code này nhé.

Mã:

Sub laydulieu()
    Dim arr, i As Long, lr As Long, kq, a As Long, dic As Object, j As Integer, b As Integer, dk As String, c As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("data")
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         arr = .Range("A2:F" & lr).Value
         ReDim kq(1 To UBound(arr), 1 To 8)
         For i = 1 To UBound(arr)
             dk = arr(i, 2) & " " & arr(i, 4) & " " & arr(i, 5) & " " & arr(i, 3) & " " & arr(i, 6)
             If Not dic.exists(dk) Then
                dic.Add dk, Array(0, i)
             End If
             b = dic.Item(dk)(0) + 1
             c = dic.Item(dk)(1)
             dic.Item(dk) = Array(b, c)
             If b = 2 Then
                 a = a + 1
                For j = 1 To 6
                    kq(a, j) = arr(c, j)
                Next j
                kq(a, 7) = dk
                a = a + 1
                For j = 1 To 6
                    kq(a, j) = arr(i, j)
                Next j
                    kq(a, 7) = dk
             ElseIf b > 2 Then
                a = a + 1
                For j = 1 To 6
                    kq(a, j) = arr(i, j)
                Next j
                    kq(a, 7) = dk
             End If
        Next i
        For i = 1 To a
            kq(i, 8) = dic.Item(kq(i, 7))(0)
        Next i
   End With
   With Sheets("ket qua")
        lr = .Range("A" & Rows.Count).End(xlUp).Row
        If lr > 2 Then .Range("A2:H" & lr).ClearContents
        If a Then .Range("A2:H2").Resize(a).Value = kq
   End With
End Sub

Vâng cảm ơn bạn đã giúp đỡ ạ

Xin hướng dẫn Code VBA hàm Countif dữ liệu lớn trăm ngàn dòng

Thành viên mới

File đính kèm

Ăn cùng góc phố

Thành viên mới

Thành viên gạo cội

Ăn cùng góc phố

Thành viên gắn bó

Thành viên gạo cội

Thành viên gắn bó

/(hông là gì!

Thành viên gạo cội

Thành viên gạo cội

Thành viên gắn bó

Thành viên gạo cội

Thành viên gắn bó

Thành viên gắn bó

Thành viên gạo cội

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

File đính kèm

Thành viên mới

Thành viên gạo cội

Thành viên mới