Is there a faster CountIF

后端 未结 3 469
野性不改
野性不改 2020-11-27 07:10

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

3条回答
  •  南笙
    南笙 (楼主)
    2020-11-27 07:48

    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 1¹ - 10K rows × 2 columns filled with RANDBETWEEN(1, 999)
            COUNTIF formula:           15.488 seconds
            MATCH formula:                1.592 seconds 
     
        Test 2² - 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. 
       ¹ More multiples; less zero counts 
       ² 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.

提交回复
热议问题