nhiều so với trực giác của tôi một VBA tìm kiếm nhị phân mạnh nhanh hơn so với một Excel Find. Ít nhất với kịch bản dưới đây, nơi 120.000 6 chuỗi ký tự được phân bố đều trên 3 trang tính.
Excel Tìm mất 1 phút 58 giây,
Tìm kiếm nhị phân VBA mất 36 giây trên máy cụ thể của tôi.
Lợi thế của việc biết rằng văn bản theo thứ tự rõ ràng vượt trội hơn lợi thế tự nhiên của Excel. Lưu ý cảnh báo của Aladin A về thứ tự sắp xếp.
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
Cảm ơn bạn. Làm một trường hợp thử nghiệm tìm kiếm 1000 ví dụ bên trong 52000 khả năng (một trang tính), tôi nhận được 17 giây cho Excel Tìm kiếm so với 5,5 giây cho Tìm kiếm nhị phân. Chà là tìm kiếm nhị phân thất bại 25% thời gian. Tôi nghĩ rằng vấn đề là loại excel cho các chuỗi được đặt hàng khác với so sánh ">" và "<" của VBA. – ExcelCyclist
Đã loại vỏ hồ sơ, và tìm kiếm nhị phân hoạt động tuyệt vời! 2000 ví dụ ngẫu nhiên, trong đó tìm thấy từ 52000 hàng trong 36 giây (excel find) so với 11 giây (tìm kiếm nhị phân). – ExcelCyclist