Excel VBA-如何更有效地进行计数? [英] Excel VBA - How to do countif more efficiently?

问题描述

我正在为电子表格处理Excel VBA代码.以下代码的目的是计算该行中的凭证编号出现在整个G列中的次数.由于原始数据有60,000多行，因此以下代码将花费2分钟以上的时间才能完成.

I am working on an Excel VBA code for a spreadsheet. The aim of the following code is to count how many times the voucher number in this row appears in the whole column G. As the raw data has more than 60,000 rows, the following code will take more than 2 mins to finish.

Worksheets("Raw Data").Range("AP2:AP" & lastrow).Formula = "=IF(AO2=""MATCHED"",""MATCHED"",IF((COUNTIF(AQ_u,G2))>0,""MATCHED"",""NOT MATCHED""))"

我还尝试了一种交替播放的方法，该方法基本上也是CountIF函数:

I also tried an alternatvie way, which basically is also a CountIF function:

Dim cel, rng As Range
Set rng = Worksheets("Raw Data").Range("AQ2:AQ" & lastrow)
For Each cel In Worksheets("Raw Data").Range("AQ2:AQ" & lastrow)
     If Application.WorksheetFunction.CountIf(rng, cel.Offset(0, -36).Value) > 0 Then
        cel.Offset(0, -1).Value = 1
     End If
Next cel

以上两个代码都需要很长时间才能完成，所以我想知道是否有一种方法可以使代码更有效?非常感谢.

Both of the codes above take a long time to finish, so I am wondering whether there is a way to make the code more efficient? Many thanks.

推荐答案

尝试下面的代码(它使用数组和字典)

Try the code bellow (it uses an array and a dictionary)

对于字典，后期绑定很慢: CreateObject("Scripting.Dictionary")

早期绑定速度很快:VBA编辑器->工具->参考->添加Microsoft脚本运行时

Early binding is fast: VBA Editor -> Tools -> References -> Add Microsoft Scripting Runtime

---

Option Explicit

Public Sub CountVouchers()
    Const G     As Long = 7     'col G
    Const AQ    As Long = 43    'col AQ

    Dim ws  As Worksheet:   Dim i  As Long:     Dim d As Dictionary
    Dim arr As Variant:     Dim lr As Long:     Dim t As Double

    t = Timer:              Set d = New Dictionary

    Set ws = ThisWorkbook.Worksheets("Raw Data")
    lr = ws.Cells(ws.Rows.Count, AQ).End(xlUp).Row
    ws.Columns("AP").Clear

    arr = ws.Range(ws.Cells(1, 1), ws.Cells(lr, AQ))                'Range to Array
        For i = 2 To lr
            If Len(Trim(arr(i, AQ))) > 0 Then d(CStr(arr(i, AQ))) = 1
        Next
        For i = 2 To lr
            If d.Exists(CStr(arr(i, G))) Then arr(i, AQ - 1) = 1    'Count
        Next
    ws.Range(ws.Cells(1, 1), ws.Cells(lr, AQ)) = arr                'Array back to Range

Debug.Print "Rows: " & Format(lr, "#,###") & ", Time: " & Format(Timer - t, ".000") & " sec"

    'Rows: 100,001, Time: 1.773 sec

End Sub

---

如果您想查看每个凭单的总出现次数:

---

If you want to see total number of occurrences for each voucher:

Public Sub CountVoucherOccurrences()
    Const G     As Long = 7
    Const AQ    As Long = 43

    Dim ws  As Worksheet:   Dim i  As Long:     Dim d As Dictionary
    Dim arr As Variant:     Dim lr As Long:     Dim t As Double

    t = Timer:              Set d = New Dictionary

    Set ws = ThisWorkbook.Worksheets("Raw Data")
    lr = ws.Cells(ws.Rows.Count, AQ).End(xlUp).Row
    ws.Columns("AP").Clear

    arr = ws.Range(ws.Cells(1, 1), ws.Cells(lr, AQ))
        For i = 2 To lr
            d(arr(i, AQ)) = IIf(Not d.Exists(arr(i, AQ)), 1, d(arr(i, AQ)) + 1)
        Next
        For i = 2 To lr
           If d.Exists(arr(i, G)) Then arr(i, AQ - 1) = d(arr(i, AQ))
        Next
    ws.Range(ws.Cells(1, 1), ws.Cells(lr, AQ)) = arr

Debug.Print "Rows: " & Format(lr, "#,###") & ", Time: " & Format(Timer - t, ".000") & " sec"

    'Rows: 100,001, Time: 1.781 sec

End Sub

这篇关于Excel VBA-如何更有效地进行计数?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！