Excel 查找速度与 VBA 二进制搜索?

发布于 2024-08-14 04:24:13 字数 455 浏览 7 评论 0原文

Excel VBA 的查找与二分搜索相比有多好/快?我的平台是 Office 11|2003,我将在三张值上针对 A 列搜索字符串。总行数 ~140,000

如果值得哪个库和?我应该引用函数来进行排序然后进行二分搜索?据报道,二进制搜索字符串/文本存在潜在问题。

...一件事 必须注意。使用二分查找 带有排序文本的公式需要 警告。 Aladin A.,Excel MVP

Excel 查找:

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

How good/fast is Excel VBA's Find vs. binary search? My platform is Office 11|2003 and I'll be searching for strings against Column A on three sheets of values. Total number of rows ~140,000

If worth it which Library & functions should I reference to do the sorting and then the binary search? Binary searching strings/text reportedly has potential problems.

... one thing
must be noted. Using binary search
formulas with sortedtextrequires
caution. Aladin A., Excel MVP

Excel Find:

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

如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(4

若言繁花未落 2024-08-21 04:24:13

与我的直觉相反,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

Much against my intuition a VBA binary search strongly outperforms an Excel Find. At least with the scenario below where 120,000 6 character strings are distributed evenly over 3 worksheets.

Excel Find takes 1 minute 58 seconds,
VBA binary search takes 36 seconds on my particular machine.

The advantage of knowing that the text is in order obviously outweighs Excel's natural advantage. Note Aladin A's warning about sort order.

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
叫思念不要吵 2024-08-21 04:24:13

我发现使用自动筛选比使用任何方法手动搜索记录要快得多。

我进行过滤,检查是否有任何结果,然后继续。如果找到任何内容(通过检查结果计数),我可以搜索手动过滤的一小部分或将其全部返回。

我在大约 44,000 条记录中使用了它,并根据它搜索了 100 多个部件的列表。

如果不小心,二分搜索很容易陷入无限循环。

I find using the AutoFilter works a lot faster than manually searching the records with any method.

I filter, check to see if there are any results, then move on. If any are found (by checking the count of results), I can search the small portion that are filtered manually or return them all.

I used it on around 44,000 records, searching for a list of 100+ parts against it.

Binary searches can easily get stuck in infinite loops if you're not careful.

你如我软肋 2024-08-21 04:24:13

如果您将 vlookup 与排序选项一起使用,它可能会比您的 vba 更快。

If you use vlookup with the sorted option, it will likely be faster than your vba.

深海少女心 2024-08-21 04:24:13

我对此很感兴趣,因为我正在使用 .Find 功能,在一台电脑上它无法进行某些查找,但在另一台电脑上却没问题!所以我对计时做了一些测试 - 我有一张按顺序排序的 985 个名称的表,并且我编写了一个小子例程来运行它们,并使用不同的方法在同一个列表中查找每个名称(时间以毫秒为单位):

  1. 暴力: 2000
  2. .Find: 750
  3. Application.VLookup: 265
  4. 二分查找: 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

I have become interested in this because I was using the .Find function, and on one PC it failed to work on some lookups, but on another it was OK! So I've done some testing on timings - I've got a sheet with 985 names sorted into order, and I've written a small subroutine to run through them, and look each one up in the same list using a different method (the times are in milliseconds):

  1. Brute force: 2000
  2. .Find: 750
  3. Application.VLookup: 265
  4. Binary Search: 234

The problem with VLookup is that it can't return the row number unless you include it in your table.

Here is my code for the Binary search, I've assumed that the sheet has a header row, but you could easily modify the header and code to pass that information. The optional Col parameter is used to indicated if you want the row number, or a cell's value. The function returns 0 (zero) if the find fails.

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
~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文