VB6：如何快速搜索数组？

Question

比如说，我有一个包含50000个元素的字符串数组。使用 For Next 在这么大的数组中查找是非常慢的。有没有更快速的方法来进行搜索呢？

注意：我们可以使用 join 和 instr 来在数组中搜索字符串，但是这种方法不好用，因为我无法找到元素的编号。

注意：数组未排序且我正在寻找子字符串。

- Nok Imchen

---

数组是否已排序？按您的标准，什么是慢的？您想要达到的性能是什么？ - rene

一个断开的记录集可能是最简单和最快的。 - Fionnuala

你是在寻找精确匹配还是子字符串？ - mwolfe02

以下是有关断开式记录集的一些注释：https://dev59.com/mUXRa4cB1Zd3GeqPs5Sm - Fionnuala

UBound(Filter(stringArray, itemToFind)) > -1 这个代码可以告诉你该元素是否在数组中。 - JimmyPena

Answer 1

尝试使用Filter(InputStrings, Value[, Include[, Compare]])函数，它返回匹配字符串的数组。

完整的语法可以在MSDN上找到。

- jac

---

但是这样会更快吗？顺便说一下，我已经编辑了链接，将其指向VB6文档而不是Vb.Net文档。 - MarkJ

@MarkJ - 我不知道，因为我懒得创建一个50000个元素的数组进行测试，虽然内置函数通常是用C或C++编写并进行优化。此外，我意识到如果他需要元素的索引，这还不够完整。非常感谢您修复链接。 - jac

@MarkJ，你让我很好奇，于是我加载了一个包含50000个随机单词的数组，并进行了几次搜索。使用GetTickCount函数返回大多数搜索结果为78毫秒。虽然不如Dick Kusleika的结果好，但仍然非常快速。 - jac

Answer 2

这是你使用 Join 和 InStr 的想法的扩展：

Sub TestArraySearch()
Dim A(4) As String
    A(0) = "First"
    A(1) = "Second"
    A(2) = "Third"
    A(3) = "Fourth"
    A(4) = "Fifth"
    Debug.Print FastArraySearch(A, "Fi")
    Debug.Print FastArraySearch(A, "o")
    Debug.Print FastArraySearch(A, "hird")
    Debug.Print FastArraySearch(A, "Fou")
    Debug.Print FastArraySearch(A, "ndTh")
    Debug.Print FastArraySearch(A, "fth")
End Sub

Function FastArraySearch(SearchArray As Variant,SearchPhrase As String) As String
Dim Pos As Long, i As Long, NumCharsProcessed As Long, Txt As String
    Pos = InStr(Join(SearchArray, "§"), SearchPhrase)
    If Pos > 0 Then
        For i = LBound(SearchArray) To UBound(SearchArray)
            NumCharsProcessed = NumCharsProcessed + Len(SearchArray(i)) + 1
            If NumCharsProcessed >= Pos Then
                FastArraySearch = SearchArray(i)
                Exit Function
            End If
        Next i
    End If
End Function

我没有进行基准测试，但这应该比每次在循环中单独搜索更快。它只搜索一次，然后只是累加字符串长度，直到找到匹配为止。由于字符串的长度存储在字符串中的任何字符之前，因此Len函数高度优化。

如果这种性能仍然无法接受，我认为您需要找到一个不同的数据结构而不是数组（例如，像@Remou建议的断开连接记录集）。

- mwolfe02

---

嗯，这个返回数组索引的方法确实很慢 :( - Nok Imchen

Answer 3

您能展示一下您正在使用的代码以及它需要多长时间吗？另外，多长时间算是过长呢？这段代码读入了50,000个字符串，并在约300毫秒内找到了其中包含子字符串的275个。

Sub testarr()

    Dim vaArr As Variant
    Dim i As Long
    Dim dTime As Double
    Dim lCnt As Long

    dTime = Timer

    vaArr = Sheet1.Range("A1:A50000")

    For i = LBound(vaArr, 1) To UBound(vaArr, 1)
        If InStr(1, vaArr(i, 1), "erez") > 0 Then
            lCnt = lCnt + 1
            Debug.Print i, vaArr(i, 1)
        End If
    Next i

    Debug.Print Timer - dTime
    Debug.Print lCnt

End Sub

- Dick Kusleika

---

+1 表示“多长时间算太长”？300 毫秒的时间包括 Debug.Print 匹配结果的时间吗？你能在不使用 Debug.Print 的情况下计时并分享结果吗？ - JeffK

JeffK说得好。在循环中去掉Debug.Print，时间只有略微超过30毫秒。这应该足够快了。 - Dick Kusleika

Answer 4

在VB6中加速任何数组索引操作的最佳方法是使用以下选项重新编译组件：

• 单击“项目”菜单项中的“属性”
• 单击“编译”选项卡
• 单击“高级优化”按钮
• 选中“删除数组边界检查”
• 按下“确定”等按钮。

现在，您的数组索引应该与等效的C/C++操作一样快。

唯一的问题是，您应确保您的代码永远不会引用其正常数组边界之外的索引。以前，您会收到VB运行时错误。之后，您可能会收到访问冲突的错误。

- Mark Bertenshaw

Answer 5

我使用了Joins和Splits，但没有进行任何benchmark测试：

Function IndexOf(ByRef arr() As String, ByVal str As String) As Integer
    Dim joinedStr As String
    Dim strIndex As Integer
    joinedStr = "|" & Join(arr, "|")
    strIndex = InStr(1, joinedStr, str)
    If strIndex = 0 Then
        IndexOf = -1
        Exit Function
    End If
    joinedStr = Mid(joinedStr, 1, strIndex - 1)
    IndexOf = UBound(Split(joinedStr, "|")) - 1
End Function

- John Pangilinan

Answer 6

这里有一个快速返回子字符串出现次数的方法。希望能帮到你！

Option Explicit
Option Compare Binary
Option Base 0
DefLng A-Z
Sub TestSubStringOccurence()

Dim GrabRangeArray() As Variant
Dim i As Long
Dim L As Long
Dim RunTime As Double
Dim SubStringCounter As Long
Dim J As Long
Dim InStrPosition As Long
Dim Ws As Excel.Worksheet

Set Ws = ThisWorkbook.Sheets("Sheet1")

RunTime = Timer

With Ws    
    For i = 1 To 50000
        If i Mod 2 = 0 Then .Cells(i, 1).Value2 = "1 abcdef 2 abcdef 3 abcdef 4 abcdef 5 abcdef" _
        Else .Cells(i, 1).Value2 = i        Next i

    GrabRangeArray = .Range("a1:a50000").Value        
End With    
RunTime = Timer

'returns number of substring occurrences

For i = 1 To UBound(GrabRangeArray, 1)
    InStrPosition = 1
    Do
        InStrPosition = InStr(InStrPosition, GrabRangeArray(i, 1), "abcdef", vbBinaryCompare)
        If InStrPosition <> 0 Then
            SubStringCounter = SubStringCounter + 1
            InStrPosition = InStrPosition + 6
        End If
    Loop Until InStrPosition = 0
Next i

Debug.Print "Runtime: " & Timer - RunTime & ", ""abcdef"" occurences: " & SubStringCounter
End Sub

这里有一种快速的方法来测试子字符串是否存在，但不返回子字符串出现的次数。

Option Explicit
Option Compare Binary
Option Base 0
DefLng A-Z
Sub TestSubStringOccurence()
Dim GrabRangeArray() As Variant
Dim I As Long
Dim L As Long
Dim RunTime As Double
Dim SubStringCounter As Long
Dim J As Long
Dim InStrPosition As Long
Dim Ws As Excel.Worksheet
Const ConstABCDEFString As String = "abcdef"
Dim B As Boolean

Set Ws = ThisWorkbook.Sheets("Sheet1")

RunTime = Timer

ReDim GrabRangeArray(0 To 49999)
With Ws
For I = 1 To 50000
    If I Mod 2 = 0 Then GrabRangeArray(I - 1) = "1 abcdef 2 abcdef 3 abcdef 4 abcdef 5 abcdef" _
    Else GrabRangeArray(I - 1) = I - 1
Next I

.Range("a1:a50000").Value = Application.Transpose(GrabRangeArray)

End With

RunTime = Timer

For I = 1 To UBound(GrabRangeArray, 1)
    If InStrB(1, GrabRangeArray(I), ConstABCDEFString, vbBinaryCompare) Then _
    SubStringCounter = SubStringCounter + 1
Next I

Debug.Print "Runtime: " & Timer - RunTime & ", ""abcdef"" occurences: " & SubStringCounter    
End Sub

- JoeB

Answer 7

John的代码改进版（如果你搜索一个字符串，它可以找到第一个出现的位置，即使该字符串不完全符合你的搜索条件，例如：你搜索"and"，你的数组是"me and you"，"just"，"and"，它返回3而不是1）。

Function IndexOf(ByRef arr() As String, ByVal str As String) As Integer
Dim tuttook As Boolean
Dim joinedStr As String
Dim strIndex As Integer
strIndex = 0
tuttook = False
    joinedStr = "|" & Join(arr, "|")
    While tuttook = False
        strIndex = InStr(strIndex + 1, joinedStr, str)
        If strIndex = 0 Then
            IndexOf = -1
            Exit Function
        Else
            If Mid(joinedStr, strIndex - 1, 1) = "|" And Mid(joinedStr, strIndex + Len(str), 1) = "|" Then tuttook = True
        End If
    Wend
    joinedStr = Mid(joinedStr, 1, strIndex - 1)
    IndexOf = UBound(Split(joinedStr, "|")) - 1
End Function

- Alessio Formenti