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

Liên hệ QC
H

Hugo Nguyen

Thành viên mới
Tham gia
15/8/20
Bài viết
38
Được thích
4
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.
 

File đính kèm

  • Code VBA hàm Countif.xlsm
    50.3 KB · Đọc: 37
Sắp xếp theo thời gian sắp xếp theo bầu chọn
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.
 
Upvote 0
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.
Nhấp chuột vào đây để mở rộng...
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ý ạ.
 
Upvote 0
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.
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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ý ạ.
Nhấp chuột vào đây để mở rộng...
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.
 
Upvote 0
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.
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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.
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
snow25 đã viết:
Mình viết code bài 4 đó bạn xem.
Nhấp chuột vào đây để mở rộng...
Em đã chạy code nhưng dường như không đúng ý đồ chủ thớt
Bài đã được tự động gộp:

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
 
Upvote 0
snow25 đã viết:
Khác chỗ nào nhỉ bạn.Để mình xem lại.:D.
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
OT cũng thấy bài hay nên cũng tham gia hóng hớt :D
...
Ơ..ơ! 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) ^_^
 
Lần chỉnh sửa cuối:
Upvote 0
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:

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
Nhấp chuột vào đây để mở rộng...
Đâ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
 
Upvote 0
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.
Nhấp chuột vào đây để mở rộng...
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)
1602234987284.png
 

File đính kèm

  • Code VBA hàm Countif.xlsx
    181.4 KB · Đọc: 21
Upvote 0
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.
Nhấp chuột vào đây để mở rộng...
Vâng, xin cảm ơn góp ý của bạn nhé!
Bài đã được tự động gộp:

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/
Nhấp chuột vào đây để mở rộng...
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:

Xin cảm ơn sự trợ giúp của mọi người rất nhiều ạ ^^
 
Upvote 0
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.
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...
Vâng cảm ơn bạn đã giúp đỡ ạ
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

C
  • Question
VBA copy 2 vùng dữ liệu từ 1 workbook này sang 2 vùng của workbook khác!
    • Phẫn nộ
Trả lời
5
Đọc
70
Hoàng Tuấn 868
H
Emyeuexcel
  • Question
In theo số thứ tự
    • Chấp nhận
Trả lời
2
Đọc
54
Emyeuexcel
Emyeuexcel
M
...
    • Cười
Trả lời
4
Đọc
84
Hoàng Tuấn 868
H
phanngoctrai1981
  • Question
Tính trung bình theo các nhóm bằng VBA
Trả lời
6
Đọc
143
Hoàng Tuấn 868
H
kiencuong030184
  • Question
ẩn hiện dòng, cột có điều kiên
Trả lời
1
Đọc
28
SA_DQ
SA_DQ
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom