Excel Trova la velocità rispetto alla ricerca binaria VBA?

Question

Quanto è buono/veloce la ricerca di VBA di Excel e la ricerca binaria? La mia piattaforma è Office 11 | 2003 e cercherò stringhe contro la Colonna A su tre fogli di valori. Numero totale di righe ~ 140.000

Se valesse quale funzione della libreria & dovrei fare riferimento all'ordinamento e quindi alla ricerca binaria? Eventuali stringhe di ricerca binaria/testo hanno potenziali problemi.

... una cosa deve essere annotata. Utilizzando la ricerca binaria formule con tati ordinati cautela. Aladin A., Excel MVP

Excel Trova:

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

Answer 1

contro la mia intuizione a VBA ricerca binaria sorpassa fortemente un Excel Trova. Almeno con lo scenario seguente in cui 120.000 stringhe di 6 caratteri sono distribuite uniformemente su 3 fogli di lavoro.

Excel Find impiega 1 minuto 58 secondi,
La ricerca binaria VBA impiega 36 secondi sulla mia macchina specifica.

Il vantaggio di sapere che il testo è in ordine ovviamente supera il vantaggio naturale di Excel. Nota l'avvertimento di Aladin A sull'ordinamento.

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 

Answer 2

Trovo che usare AutoFilter funzioni molto più velocemente rispetto alla ricerca manuale dei record con qualsiasi metodo.

I filtro, controllare se ci sono risultati, quindi andare avanti. Se ne viene trovato uno (controllando il conteggio dei risultati), posso cercare la porzione piccola che viene filtrata manualmente o restituirli tutti.

L'ho utilizzato su circa 44.000 record, cercando un elenco di oltre 100 parti contro di esso.

Le ricerche binarie possono facilmente rimanere bloccate in cicli infiniti se non si fa attenzione.

Answer 3

Se si utilizza vlookup con l'opzione ordinata, sarà probabilmente più veloce del tuo vba.