2009-12-07 28 views
6

Excel VBA的Find和二進制搜索有多好/快?我的平臺是Office 11 | 2003,我將在三張值上搜索字符串A列。總行數〜140,000Excel查找速度與VBA二進制搜索?

如果值得哪個庫函數我應該參考做排序然後二進制搜索?據稱二進制搜索字符串/文本有潛在的問題。

...有一件事 必須注意。使用二進制搜索 公式與sortedtextrequires 小心。 Aladin A., Excel MVP

Excel中查找:

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

回答

7

很多反對我的直覺VBA二進制搜索強烈勝過一個Excel查找。至少在下面的場景中,120,000個6個字符的字符串均勻分佈在3個工作表中。

Excel查找需要1分58秒,
VBA二分查找在我的特定機器上需要36秒。

瞭解文本的順序顯然勝過Excel的天然優勢。請注意Aladin A對排序順序的警告。

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 
+0

謝謝。在52000個可能性(單張)內搜索1000個示例的測試案例中,Excel搜索的搜索時間爲17秒,二進制搜索的搜索時間爲5.5秒。揉搓是二分查找失敗的25%時間。我認爲問題在於excel的排序方式與VBA的「>」和「<」比較有所不同。 – ExcelCyclist 2009-12-13 15:13:59

+0

是否有shell的記錄,二進制搜索很好! 2000個隨機例子,其中36秒(excel查找)中的52000行與11秒(二元查找)中的查找結果一致。 – ExcelCyclist 2009-12-13 23:29:17

3

我發現使用AutoFilter比使用任何方法手動搜索記錄的速度快很多。

我過濾,檢查是否有任何結果,然後繼續。如果找到任何東西(通過檢查結果的數量),我可以搜索手動過濾的小部分或全部返回。

我在大約44,000條記錄上使用它,搜索100多個零件的列表。

如果您不小心,二進制搜索很容易陷入無限循環。

3

如果你使用vlookup和排序選項,它可能會比你的vba更快。