Excel查找速度与VBA二进制搜索？ [英] Excel Find Speed vs. VBA binary Search?

问题描述

Excel VBA的查找与二进制搜索有多好/快？我的平台是Office 11 | 2003，我将在三列值上搜索列A的字符串。总行数〜140,000

How good/fast is Excel VBA's Find vs. binary search? My platform is Office 11|2003 and I'll be searching for strings against Column A on three sheets of values. Total number of rows ~140,000

如果值得，那么Library&函数应该引用做排序然后进行二进制搜索？二进制搜索字符串/文本据报有潜在的问题。

If worth it which Library & functions should I reference to do the sorting and then the binary search? Binary searching strings/text reportedly has potential problems.

...一件事必须注意的是
。使用二进制搜索
公式与sortedtextrequires
警告。 阿拉丁A.，Excel MVP

Excel查找：

Worksheets(1).Range("A:A").Find("PN-String-K9", LookIn:=xlValues, LookAt:=xlWhole)

推荐答案

对我的直觉来说，VBA二进制搜索强大优于Excel Find。至少在下面的场景中，120,000个6个字符的字符串均匀分布在3个工作表中。

Much against my intuition a VBA binary search strongly outperforms an Excel Find. At least with the scenario below where 120,000 6 character strings are distributed evenly over 3 worksheets.

Excel查找需要1分58秒，

VBA二进制搜索在我的特定机器上需要36秒。

Excel Find takes 1 minute 58 seconds,
VBA binary search takes 36 seconds on my particular machine.

知道文本顺序的优点显然超过了Excel的自然优势。注意阿拉丁A关于排序顺序的警告。

The advantage of knowing that the text is in order obviously outweighs Excel's natural advantage. Note Aladin A's warning about sort order.

Option Explicit

' Call Search to look for a thousand random strings
' in 3 worksheets of a workbook

' requires a workbook with 3 sheets and
' column A populated with values between "00001" to "120000"
' split evenly 40,000 to a worksheet in ascending order.
' They must be text, not numbers.

Private Const NUM_ROWS As Long = 120000
Private Const SHEET_1 As String = "Sheet1"
Private Const SHEET_2 As String = "Sheet2"
Private Const SHEET_3 As String = "Sheet3"

' This uses VBA Binary Search
Public Sub Search()
    Worksheets(SHEET_1).Range("B:B").ClearContents
    Worksheets(SHEET_2).Range("B:B").ClearContents
    Worksheets(SHEET_3).Range("B:B").ClearContents
    DoSearch True       ' change to False to test Excel search
End Sub

' Searches for a thousand values using binary  or excel search depending on
' value of bBinarySearch
Public Sub DoSearch(ByVal bBinarySearch As Boolean)
    Debug.Print Now
    Dim ii As Long

    For ii = 1 To 1000
        Dim rr As Long
        rr = Int((NUM_ROWS) * Rnd + 1)
        If bBinarySearch Then
            Dim strSheetName As String
            Dim nRow As Long
            If BinarySearch(MakeSearchArg(rr), strSheetName, nRow) Then
                Worksheets(strSheetName).Activate
                Cells(nRow, 1).Activate
            End If
        Else
            If Not ExcelSearch(SHEET_1, MakeSearchArg(rr)) Then
                If Not ExcelSearch(SHEET_2, MakeSearchArg(rr)) Then
                    ExcelSearch SHEET_3, MakeSearchArg(rr)
                End If
            End If
        End If
        ActiveCell.Offset(0, 1).Value = "FOUND"
    Next
    Debug.Print Now

End Sub

' look for one cell value using Excel Find
Private Function ExcelSearch(ByVal strWorksheet As String _
  , ByVal strSearchArg As String) As Boolean
    On Error GoTo Err_Exit
    Worksheets(strWorksheet).Activate
    Worksheets(strWorksheet).Range("A:A").Find(What:=strSearchArg, LookIn:=xlValues, LookAt:= 
        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True 
        , SearchFormat:=False).Activate
    ExcelSearch = True
    Exit Function
Err_Exit:
    ExcelSearch = False
End Function

' Look for value using a vba based binary search
' returns true if the search argument is found in the workbook
' strSheetName contains the name of the worksheet on exit and nRow gives the row
Private Function BinarySearch(ByVal strSearchArg As String _
  , ByRef strSheetName As String, ByRef nRow As Long) As Boolean
    Dim nFirst As Long, nLast As Long
    nFirst = 1
    nLast = NUM_ROWS
    Do While True
        Dim nMiddle As Long
        Dim strValue As String
        If nFirst > nLast Then
            Exit Do     ' Failed to find search arg
        End If
        nMiddle = Round((nLast - nFirst) / 2 + nFirst)
        SheetNameAndRowFromIdx nMiddle, strSheetName, nRow
        strValue = Worksheets(strSheetName).Cells(nRow, 1)
        If strSearchArg < strValue Then
            nLast = nMiddle - 1
        ElseIf strSearchArg > strValue Then
            nFirst = nMiddle + 1
        Else
            BinarySearch = True
            Exit Do
        End If
    Loop
End Function

' convert 1 -> "000001", 120000 -> "120000", etc
Private Function MakeSearchArg(ByVal nArg As Long) As String
    MakeSearchArg = Right(CStr(nArg + 1000000), 6)
End Function

' converts some number to a worksheet name and a row number
' This is depenent on the worksheets being named sheet1, sheet2, sheet3

' and containing an equal number of vlaues in each sheet where
' the total number of values is NUM_ROWS
Private Sub SheetNameAndRowFromIdx(ByVal nIdx As Long _
  , ByRef strSheetName As String, ByRef nRow As Long)
    If nIdx <= NUM_ROWS / 3 Then

        strSheetName = SHEET_1
        nRow = nIdx
    ElseIf nIdx > (NUM_ROWS / 3) * 2 Then
        strSheetName = SHEET_3
        nRow = nIdx - (NUM_ROWS / 3) * 2
    Else
        strSheetName = SHEET_2
        nRow = nIdx - (NUM_ROWS / 3)
    End If
End Sub

这篇关于Excel查找速度与VBA二进制搜索？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！