Excel VBA – 如何更有效地做countif？
我正在为一个电子表格Excel Excel VBA代码工作。 以下代码的目的是计算此行中凭证号码出现在整个列G中的次数。由于原始数据有超过60,000行，以下代码将花费超过2分钟时间来完成。
Worksheets("Raw Data").Range("AP2:AP" & lastrow).Formula = "=IF(AO2=""MATCHED"",""MATCHED"",IF((COUNTIF(AQ_u,G2))>0,""MATCHED"",""NOT MATCHED""))" 我也尝试了一种方法，它基本上也是一个CountIF函数：
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
上面的代码需要很长时间才能完成，所以我想知道是否有办法让代码更有效率？ 非常感谢。
尝试下面的代码（它使用数组和字典）
对于字典，后期绑定很慢：
CreateObject（“Scripting.Dictionary”）早期绑定是快速的 ：VBA编辑器 – >工具 – >引用 – >添加Microsoft脚本运行时
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
如果您想查看每个优惠券的总次数：
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