VB6：如何快速搜索数组？

Question

说，我有一个包含 50000 个元素的字符串数组。对于如此庞大的数组，使用For Next 搜索数组非常慢。有什么快速搜索的方法吗？

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

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

Answer 1

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

完整的语法可以在MSDN找到

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 建议的那样，断开连接的记录集）。

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

Answer 4

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

• 单击项目“属性”菜单项
• 点击“编译”标签
• 点击“高级优化”按钮
• 勾选“删除数组边界检查”
• 按确定等

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

唯一的问题是您应该确保您的代码从不引用超出其正常数组范围的索引。以前，您会收到一个 VB 运行时错误。在此之后，您可能会得到访问冲突。

Answer 5

这是一种返回子字符串出现次数的快速方法。希望对您有所帮助！

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

Answer 6

好吧，我使用了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