6

Excel VBA の検索と二分探索はどれくらい優れていますか? 私のプラットフォームは Office 11|2003 で、3 つの値シートの列 A に対して文字列を検索します。総行数 ~140,000

価値がある場合、並べ替えを行ってからバイナリ検索を行うために、どのライブラリと関数を参照する必要がありますか? 文字列/テキストのバイナリ検索には潜在的な問題があると報告されています。

…一つだけ注意が必要です。ソートされたテキストで二分探索式を使用するには注意が必要です。 Aladin A.、Excel MVP

Excel 検索:

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

4 に答える 4

8

私の直感に反して、VBAバイナリ検索はExcel検索よりも大幅に優れています。少なくとも、120,000個の6文字の文字列が3つのワークシートに均等に分散されている以下のシナリオでは。

私の特定のマシンでは、Excel検索に1分58秒、
VBAバイナリ検索に36秒かかります。

テキストが正しいことを知っていることの利点は、明らかにExcelの自然な利点を上回っています。ソート順に関するAladinAの警告に注意してください。

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
于 2009-12-12T12:15:03.147 に答える
3

AutoFilter を使用すると、他の方法でレコードを手動で検索するよりもはるかに高速に機能することがわかりました。

フィルターをかけ、結果があるかどうかを確認してから、次に進みます。(結果の数を確認することによって) 見つかった場合は、手動でフィルター処理された小さな部分を検索するか、それらすべてを返すことができます。

約 44,000 のレコードで使用し、100 以上のパーツのリストを検索しました。

注意しないと、バイナリ検索は簡単に無限ループに陥る可能性があります。

于 2010-01-09T19:34:03.940 に答える
3

sorted オプションを指定して vlookup を使用すると、vba よりも高速になる可能性があります。

于 2011-04-18T21:06:10.420 に答える