Excel Найти скорость по сравнению сБинарный поиск VBA?
-
13-09-2019 - |
Вопрос
Насколько хорошо/быстро работает средство поиска Excel VBA по сравнению с поиском?бинарный поиск?Моя платформа — Office 11|2003, и я буду искать строки по столбцу A на трех листах значений.Общее количество строк ~140 000.
Если стоит того, на какую библиотеку и функции мне следует ссылаться для сортировки, а затем двоичного поиска?Сообщается, что двоичный поиск строк/текста имеет потенциальные проблемы.
...Одно нужно отметить.Использование бинарных формул поиска с SorteDtexTreequires осторожность. Аладин А., Excel MVP
Excel найти:
Worksheets(1).Range("A:A").Find("PN-String-K9", LookIn:=xlValues, LookAt:=xlWhole)
Решение
Вопреки моей интуиции, двоичный поиск VBA значительно превосходит поиск Excel.По крайней мере, в приведенном ниже сценарии, где 120 000 строк из 6 символов равномерно распределены по 3 листам.
Поиск Excel занимает 1 минуту 58 секунд,
Бинарный поиск VBA на моей конкретной машине занимает 36 секунд.
Преимущество знания того, что текст в порядке, очевидно, перевешивает естественное преимущество Excel.Обратите внимание на предупреждение Аладина А о порядке сортировки.
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
Другие советы
Я считаю, что использование автофильтра работает намного быстрее, чем ручной поиск записей любым методом.
Фильтрую, проверяю, есть ли результаты, и иду дальше.Если они найдены (путем проверки количества результатов), я могу выполнить поиск по небольшой части, отфильтрованной вручную, или вернуть их все.
Я использовал его примерно для 44 000 записей, ища список из более чем 100 его частей.
Бинарный поиск может легко застрять в бесконечных циклах, если вы не будете осторожны.
Если вы используете vlookup с опцией сортировки, он, скорее всего, будет быстрее, чем ваш vba.
Меня это заинтересовало, потому что я использовал функцию .Find, и на одном компьютере она не работала при некоторых поисках, а на другом все было в порядке!Итак, я провел некоторое тестирование таймингов — у меня есть лист с 985 именами, отсортированными по порядку, и я написал небольшую подпрограмму, которая просматривает их и ищет каждое из них в одном списке, используя другой метод ( время указано в миллисекундах):
- Грубая сила:2000 г.
- .Находить:750
- Приложение.VLookup:265
- Бинарный поиск:234
Проблема с VLookup заключается в том, что он не может вернуть номер строки, если вы не включите его в свою таблицу.
Вот мой код для двоичного поиска. Я предполагал, что на листе есть строка заголовка, но вы можете легко изменить заголовок и код для передачи этой информации.Необязательный параметр Col используется для указания, хотите ли вы получить номер строки или значение ячейки.Функция возвращает 0 (ноль), если поиск не удался.
Function Find(Sheet As Worksheet, What As String, Optional Col As Long = 0) As Variant
Dim Top As Long
Dim Mid As Long
Dim Bot As Long 'Bottom
Dim S As String
Dim T As String
With Sheet
Top = 2 'Sheet has a header row
Bot = .UsedRange.Rows.Count
S = LCase(What)
Do
Mid = (Top + Bot) / 2
T = LCase(.Cells(Mid, 1))
Select Case True
Case T > S
Bot = Mid - 1
Case T < S
Top = Mid + 1
Case Else 'T = S
If Col = 0 Then
Find = Mid 'Return the row
Else
Find = .Cells(Mid, Col).Value2 'Return the cell's value
End If
Exit Function
End Select
Loop Until Bot < Top
End With
Find = 0
End Function