Đếm số lần xuất hiện của chuỗi với lượng chuỗi lớn

[Srosro]

Chào anh chị

Em có file gồm trường "Barcode" và cần tìm"số lần xuất hiện" của từng "barcode"

em sử dụng hàm countifs như sau:

=IF(B3<>"",COUNTIFS($B$3:B3,B3),"")

Sau đó em copy và paste giá trị (value)

Tuy nhiên đối với dữ liệu ở cột Barcode lên đến khoảng 30,000 dòng là sẽ trở nên nặng file

Em muốn nhờ anh chị hỗ trợ xem còn cách nào (công thức hoặc vba) giúp quá trình tìm số lần xuất hiện của từng barcode nhanh hơn mà nhẹ file ạ

Vì thực tế khi em làm, em sẽ cần xử lý thời điểm tối đa lên đến 500,000 dòng barcode cơ ạ!

Xin cảm ơn

 

[batman1]

1. Giả thiết: barcode luôn ở Sheet1 bắt đầu từ B3, kết quả bắt đầu từ C3.

2. Trong VBE chọn menu Insert -> chọn Module -> dán code sau vào Module1 -> đặt trên sheet1 Button từ Developer -> Insert -> Form Controls -> gán cho Button sub barcode_count.

Sub barcode_count()
Dim lastRow As Long, r As Long, code As String, dulieu(), dic As Object
    With ThisWorkbook.Worksheets("Sheet1")
        .Range("C3:C600000").ClearContents  ' xoa ket qua cu
        lastRow = .Cells(Rows.Count, "B").End(xlUp).Row
        If lastRow < 3 Then Exit Sub
        dulieu = .Range("B3:B" & lastRow + 1).Value ' lay du 1 dong cuoi cung
    End With
    Set dic = CreateObject("Scripting.Dictionary")
    dic.comparemode = vbTextCompare ' khong phan biet ma Hoa ma Thuong
   
    For r = 1 To UBound(dulieu, 1) - 1  ' khong xet dong lay du
        code = dulieu(r, 1) ' ma hien hanh
        If Len(code) Then   ' neu gia tri khac RONG
            If dic.exists(code) Then
                dic.Item(code) = dic.Item(code) + 1 ' da co ma trong tu dien -> tang so luong cho ma hien hanh
            Else
                dic.Add code, 1 ' chua co ma trong tu dien -> bat dau dem tu 1
            End If
            dulieu(r, 1) = dic.Item(code)   ' dung mang dau vao lam mang ket qua vi gia tri hien hanh dau vao khong can thiet cho cac tinh toan tiep theo
        End If
    Next r
    ThisWorkbook.Worksheets("Sheet1").Range("C3").Resize(UBound(dulieu, 1) - 1).Value = dulieu
    Set dic = Nothing
End Sub

 

[Srosro]

1. Giả thiết: barcode luôn ở Sheet1 bắt đầu từ B3, kết quả bắt đầu từ C3.

2. Trong VBE chọn menu Insert -> chọn Module -> dán code sau vào Module1 -> đặt trên sheet1 Button từ Developer -> Insert -> Form Controls -> gán cho Button sub barcode_count.

Sub barcode_count()
Dim lastRow As Long, r As Long, code As String, dulieu(), dic As Object
    With ThisWorkbook.Worksheets("Sheet1")
        .Range("C3:C600000").ClearContents  ' xoa ket qua cu
        lastRow = .Cells(Rows.Count, "B").End(xlUp).Row
        If lastRow < 3 Then Exit Sub
        dulieu = .Range("B3:B" & lastRow + 1).Value ' lay du 1 dong cuoi cung
    End With
    Set dic = CreateObject("Scripting.Dictionary")
    dic.comparemode = vbTextCompare ' khong phan biet ma Hoa ma Thuong
  
    For r = 1 To UBound(dulieu, 1) - 1  ' khong xet dong lay du
        code = dulieu(r, 1) ' ma hien hanh
        If Len(code) Then   ' neu gia tri khac RONG
            If dic.exists(code) Then
                dic.Item(code) = dic.Item(code) + 1 ' da co ma trong tu dien -> tang so luong cho ma hien hanh
            Else
                dic.Add code, 1 ' chua co ma trong tu dien -> bat dau dem tu 1
            End If
            dulieu(r, 1) = dic.Item(code)   ' dung mang dau vao lam mang ket qua vi gia tri hien hanh dau vao khong can thiet cho cac tinh toan tiep theo
        End If
    Next r
    ThisWorkbook.Worksheets("Sheet1").Range("C3").Resize(UBound(dulieu, 1) - 1).Value = dulieu
    Set dic = Nothing
End Sub

Quá tuyệt vời ạ
Em cảm ơn rất nhiều ạ!