Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
1.6k views
in Technique[技术] by (71.8m points)

vba - Is there a faster CountIF

As the title says. Is there any function or VBA code which does the same function as a countif and is a lot faster. Currently in the middle of massive countif and it is just eating up my CPU.

It is just a basic countif inside the worksheet. Not in VBA. =countif(X:X,Y) However the lists are massive. So both lists are around 100,000~ rows

See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)

If you can do without a count of the occurances and simply wish to check if the value x exists in the column of y's, then returning a boolean TRUE or FALSE with the ISNUMBER function evaluating a MATCH function lookup will greatly speed up the process.

=ISNUMBER(MATCH(S1, Y:Y, 0))

Fill down as necessary to catch all returns. Sort and/or filter the returned values to tabulate results.

Addendum:

Apparently there is. The huge improvement in the MATCH function calculation times over the COUNTIF function made me wonder if MATCH couldn't be put into a loop, advancing the first cell in its lookup_array parameter to the previously returned row number plus one until there were no more matches. Additionally, subsequent MATCh calls to lookup the same number (increasing the count) could be made to increasingly smaller lookup_array cell ranges by resizing (shrinking) the height of the column by the returned row number as well. If the processed values and their counts were stored as keys and items in a scripting dictionary, duplicate values could be instantly resolved without processing a count.

Sub formula_countif_test()
    Dim tmr As Double
    appOFF
    tmr = Timer
    With Sheet2.Cells(1, 1).CurrentRegion
        With .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count) 'skip header
            .Cells(1, 3).Resize(.Rows.Count, 1).FormulaR1C1 = _
                "=countif(c1, rc2)"  'no need for calculate when blocking in formulas like this
        End With
    End With
    Debug.Print "COUNTIF formula: " & Timer - tmr
    appON
End Sub

Sub formula_match_test()
    Dim rw As Long, mrw As Long, tmr As Double, vKEY As Variant
    'the following requires Tools, References, Microsoft Scripting Dictionary
    Dim dVALs As New Scripting.dictionary
    
    dVALs.CompareMode = vbBinaryCompare  'vbtextcompare for non-case sensitive
    
    appOFF
    tmr = Timer
    
    With Sheet2.Cells(1, 1).CurrentRegion
        With .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count) 'skip header
            For rw = 1 To .Rows.Count
                vKEY = .Cells(rw, 2).Value2
                If Not dVALs.Exists(vKEY) Then
                    dVALs.Add Key:=vKEY, _
                        Item:=Abs(IsNumeric(Application.Match(vKEY, .Columns(1), 0)))
                    If CBool(dVALs.Item(vKEY)) Then
                        mrw = 0: dVALs.Item(vKEY) = 0
                        Do While IsNumeric(Application.Match(vKEY, .Columns(1).Offset(mrw, 0).Resize(.Rows.Count - mrw + 1, 1), 0))
                            mrw = mrw + Application.Match(vKEY, .Columns(1).Offset(mrw, 0).Resize(.Rows.Count - mrw + 1, 1), 0)
                            dVALs.Item(vKEY) = CLng(dVALs.Item(vKEY)) + 1
                        Loop
                    End If
                    .Cells(rw, 3) = CLng(dVALs.Item(vKEY))
                Else
                    .Cells(rw, 3) = CLng(dVALs.Item(vKEY))
                End If
            Next rw
        End With
    End With
    Debug.Print "MATCH formula: " & Timer - tmr
    dVALs.RemoveAll: Set dVALs = Nothing
    appON
End Sub

Sub appON(Optional ws As Worksheet)
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Sub appOFF(Optional ws As Worksheet)
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
End Sub

????????Sample Data for MATCH_COUNTIF

I used 10K rows with columns A and B filled by RANDBETWEEN(1, 999) then copied and pasted as values.

Elapsed times:
?
????Test 11 - 10K rows × 2 columns filled with RANDBETWEEN(1, 999)
????????COUNTIF formula:???????????15.488 seconds
????????MATCH formula:????????????????1.592 seconds?
?
????Test 22 - 10K rows × 2 columns filled with RANDBETWEEN(1, 99999)
????????COUNTIF formula:???????????14.722 seconds
????????MATCH formula:????????????????3.484 seconds?
?
I also copied the values from the COUNTIF formula into another column and compared them to the ones returned by the coded MATCH function. They were identical across the 10K rows.?
???1 More multiples; less zero counts?
???2 More zero counts, less multiples?

While the nature of the data clearly makes a significant difference, the coded MATCH function outperformed the native COUNTIF worksheet function every time.

Don't forget the VBE's Tools ? References ? Microsoft Scripting Dictionary.


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

2.1m questions

2.1m answers

60 comments

57.0k users

...