VB6: Как быстро найти массив?

Question

скажем, у меня есть массив строк из 50000 элементов.Поиск массива с использованием For Next очень медленный для такого огромного массива.Есть ли быстрый способ поиска?

Примечание: Используя join & instr, мы можем искать строку в массиве, но этот метод бесполезен, так как я не могу узнать номер элемента

Примечание: массив не отсортирован.И я ищу подстроки

Answer 1

Можете ли вы показать код, который вы используете, сколько времени это займет?Кроме того, как долго это слишком долго?Этот код читает 50000 строк и находит 275, которые содержат подстроку, всего за 300 миллисекунд.

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 2

Попробуйте использовать фильтр ( InputStrings , Значение [, Включить [, Сравнить ]]) функция. Возвращает массив совпадающих строк.

Полный синтаксис можно найти на MSDN

Answer 3

Это расширение вашей идеи использовать 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 4

Ну, я использовал 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

Answer 5

Способ ускорения любой операции индексации массива в VB6 - это перекомпилировать компонент со следующей опцией:

• Щелкните пункт меню «Свойства» проекта
• Нажмите «Скомпилируйте "Tab
• . Нажмите кнопку" Advanced Optimizations "
• Установите флажок" Удалить проверки границ массива "
• Нажмите Ok и т. Д.

Теперь вашИндексирование массива должно быть таким же быстрым, как и эквивалентная операция C / C ++.

Единственная проблема заключается в том, что вы должны убедиться, что ваш код никогда не ссылается на индексы за пределами своих нормальных границ массива.Ранее вы получали ошибку VB во время выполнения.После этого вы можете получить Access Violation.

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