Выполнение MATCH / INDEX для большого набора данных

Question

У меня есть набор данных из 55 000 строк с 35 000 адресов электронной почты, из которых 31 000 являются уникальными, поэтому несколько пользователей занимают несколько строк. Мне нужно найти строки этих пользователей и добавить их в объект класса.

Загрузка столбца электронной почты в массив и выполнение поиска MATCH / INDEX заняло 200 секунд. Пока это приемлемо, но определенно недостаточно быстро, так как планируется использовать наборы данных 200-500K.

Dim StartTime As Double
Dim SecondsElapsed As Double
StartTime = Timer

Dim dict As Dictionary
Set dict = CreateObject("scripting.dictionary")

LastRow = Cells(Rows.Count, 1).End(xlUp).Row

Set UserRange = Range(Cells(2, 11), Cells(LastRow, 11))
For Each cell In UserRange
    dict(cell.value) = dict(cell.value) + 1
Next

Debug.Print "Number of users: " & dict.Count

UserArray = Range(Cells(2, 11), Cells(LastRow, 11))
UserArray = WorksheetFunction.Transpose(WorksheetFunction.Transpose(WorksheetFunction.Transpose(UserArray)))

For Each User In dict
    Dim UserIndex() As Variant
    ReDim UserIndex(1 To dict(User))
    For i = 1 To dict(User)
        Row = WorksheetFunction.Match(User, UserArray, 0)
        UserIndex(i) = Row
        UserArray(Row) = Empty
    Next
    For i = LBound(UserIndex) To UBound(UserIndex)
        Debug.Print User, UserIndex(i)
    Next
Next

SecondsElapsed = Round(Timer - StartTime, 2)
Debug.Print "This code ran successfully in " & SecondsElapsed & " seconds"

Я мог бы построить индекс на основе блоков на основе источника (каждый импортированный файл + -10 000 записей имеет начало и конец) и ускорить его, посмотрев только в соответствующем блоке. Но, может быть, есть другой способ?

Answer 1

Вот другой подход, который довольно быстр:

Sub Lister()

    Dim t, i, m, arr, rng, dict As Object, dictDupes As Object, usr, v
    Set dict = CreateObject("scripting.dictionary")
    Set dictDupes = CreateObject("scripting.dictionary")

    Set rng = Range("A1:A500000")
    'create some dummy data (0.5M rows)
    With rng
        .Formula = "=""USER_"" & ROUND(RAND()*5000,0) & ""_"" & ROUND(RAND()*3000,0)"
        .Value = .Value
    End With

    t = Timer

    arr = rng.Value
    For i = 1 To UBound(arr, 1)
        usr = arr(i, 1)
        If Not dict.exists(usr) Then
            dict.Add usr, i
        Else
            If Not dictDupes.exists(usr) Then dictDupes.Add usr, dict(usr)
            dictDupes(usr) = dictDupes(usr) & "|" & i
        End If
    Next i

    For Each usr In dictDupes
        v = dictDupes(usr)
        'Debug.Print "----" & usr & "---"
        'Debug.Print Join(Split(v, "|"), ", ")
    Next usr

    Debug.Print dict.Count, dictDupes.Count
    Debug.Print "Done in", Timer - t

End Sub

Завершается примерно за 20-25 сек c

Еще одно примечание:

Если вы хотите используйте Match, тогда намного быстрее оставить ваши данные на листе вместо запуска Match для массива.

Sub TestMatch()

    Dim t, i, m, arr, rng

    Set rng = Range("A1:A50000")
    With rng
        .Formula = "=ROUND(RAND()*30000,0)"
        .Value = .Value
    End With

    t = Timer
    For i = 1 To 10000
        m = Application.Match(i, rng, 0)
    Next i
    Debug.Print "sheet", Timer - t

    arr = rng.Value
    t = Timer
    For i = 1 To 10000
        arr = rng.Value
        m = Application.Match(i, arr, 0)
    Next i
    Debug.Print "array", Timer - t

End Sub

Вывод:

sheet          3.644531 
array          131.9453 

Таким образом, массив равен 35x медленнее .

Answer 2

Благодаря Тиму, я получил решение:

Dim dict As Dictionary
Set dict = CreateObject("scripting.dictionary")

LastRow = Cells(Rows.Count, 1).End(xlUp).Row

Set UserRange = Range(Cells(2, 11), Cells(LastRow, 11))
For Each cell In UserRange
    dict(cell.value) = dict(cell.value) + 1
Next

Debug.Print "Number of users: " & dict.Count

t = Timer

For Each User In dict
    Set Profile = New UserProfile
    Profile.Count = dict(User)
    Dim UserIndex() As Variant
    ReDim UserIndex(1 To dict(User))
    For i = 1 To dict(User)
        Row = WorksheetFunction.Match(User, UserRange, 0)
        UserIndex(i) = Row
    Next
    For i = LBound(UserIndex) To UBound(UserIndex)
        Dim Purchase() As Variant
        ReDim Purchase(1 To LastCol) As Variant
        Purchase = Range(Cells(UserIndex(i) + 1, 1), Cells(UserIndex(i) + 1, LastCol))
        Profile.Add Purchase
    Next
Next

Debug.Print "Match/Index loop completed in ", Timer - t

Оказывается, что сравнение по диапазону вместо массива происходит намного быстрее. И поэтому чтение из диапазона вместо выполнения WorksheetFunction.Index для массива. Эти результаты были неожиданными для меня, так как я думал, что чтение / запись в книгу в целом замедляет ход событий. Я также добавил (1, к показаниям массиваPurchase в моем классе UserProfile, чтобы отказаться от транспонирования.

Профилирование для всего набора данных 55K, выполненного всего за 23 секунды!