Время прочтения: 5 мин.

Довольно часто, чтобы связать две таблицы Excel по уникальному значению (ключу) в одном из столбцов, мы применяем простую и удобную функцию ВПР(). Но в случаях, когда поиск надо выполнить в большой таблице (например более 500 тыс. строк) и еще для нескольких столбцов, мы можем не дождаться вычисления ВПР, Excel просто «зависнет».

Для таких случаев в арсенале VBA есть объект Dictionary, предназначенный для записи, хранения и использования пар, состоящих из ключа и элемента данных. Скорость поиска элемента данных по ключу в разы превышает возможности ВПР().

Перед тем как искать значение по ключу необходимо создать и заполнить словарь, все вычисления происходят в оперативной памяти компьютера без использования листа/ячеек Excel, поэтому вычисления происходят гораздо быстрее. Для примера я взял лог-файл автоматизированной системы по управлению очередями в офисах (для одного филиала организации за два месяца это составило 570 тыс. записей). Формат лог-файла на картинке:

Время обработки с использованием Dictionary составило около 3 минут.

Для визуализации процесса обработки был использован простой ProgressBar, не требующий подключения дополнительных библиотек. Для этого процедура Обработка() запущена из кода процедуры активации формы UserForm1.

Sub UserForm_Activate()
    UserForm1.Label1.Width = 1
    UserForm1.Label2.Width = 1
    Call Обработка
End Sub

Ниже я представил  код из модуля книги

Sub Начало() 'запускает форму для отображение процесса обработки
    UserForm1.Show
End Sub
-----------------------------------------------------
Sub Обработка() 'главная процедура обработки данных
    Dim НашСловарь As New Dictionary 'создадим пустой словарь
    Dim Источник() As Variant 'объявим массив для хранения строк таблицы-источника
    
    'перед заполнением очистим лист с результатом
    КолСтрокРез = Worksheets("результат").UsedRange.Rows.Count 'кол-во строк таблицы-результата
    If КолСтрокРез > 1 Then Worksheets("результат").Range(Rows(3), Rows(КолСтрокРез)).ClearContents
    
    КолСтрок = Worksheets("источник").UsedRange.Rows.Count 'кол-во строк таблицы-источника
    t1 = Format(Now, "Long Time")
    '======= 1 ЭТАП "Подготовка данных и формирование словаря" ========
    'строки из источника в массив для дальнейшей обработки
    Источник = Worksheets("источник").Range(Worksheets("Источник").Cells(3, 1), Worksheets("Источник").Cells(КолСтрок, 7)).Value
    
    'выведем на лист "результат" приход клиента в офис (тип события - 1, Получение талона)
    'и заполним словарь для последующего поиска
    n = 2
    ШагПрогресса = Int(КолСтрок / 50)
    Прогресс = 0
    For i = 1 To UBound(Источник)
        ТипСобытия = Источник(i, 5)
        If ТипСобытия = 1 Then
            n = n + 1
            Worksheets("результат").Cells(n, 1) = Источник(i, 1) 'офис
            Worksheets("результат").Cells(n, 2) = Источник(i, 2) 'дата
            Worksheets("результат").Cells(n, 3) = Источник(i, 4) 'талон
            Worksheets("результат").Cells(n, 4) = Источник(i, 3) 'время
        Else
            'вычислим ID для каждого события (офис+дата+талон+тип события)
            'запишем в словарь, где ключом будет ID, а значением одномерный массив (время события; окно)
            ID = CStr(Источник(i, 1)) + CStr(Источник(i, 2)) + CStr(Источник(i, 4)) + CStr(ТипСобытия)
            If Not НашСловарь.Exists(ID) Then 'если в словаре нет такого ID, то запишем в словарь
               НашСловарь.Add ID, Array(Источник(i, 3), Источник(i, 7))
            End If
        End If
        Прогресс = ПрогрессПоказать1(i, ШагПрогресса, Прогресс, КолСтрок)
    Next i
    t2 = Format(Now, "Long Time")
    
    '======= 2 ЭТАП "Поиск в словаре времени изменения состояний талонов" ========
    'на листе "результат" заполним состояния от 2 до 7
    ШагПрогресса = Int(n / 50)
    Прогресс = 0
    For k = 3 To n
        With Worksheets("результат")
            For j = 2 To 7
                IDj = CStr(.Cells(k, 1)) + CStr(.Cells(k, 2)) + CStr(.Cells(k, 3)) + CStr(j)
                If НашСловарь.Exists(IDj) Then 'ищем в словаре
                    .Cells(k, j + 4) = НашСловарь(IDj)(0)
                    'для события "2-вызов клиента" заполним поле "номер окна"
                    If j = 2 Then .Cells(k, 5) = НашСловарь(IDj)(1)
                End If
            Next j
            'вычислим время ожидания клиента
            .Cells(k, 12) = .Cells(k, 6) - .Cells(k, 4)
            'вычислим время обслуживания клиента
            If .Cells(k, 7) > 0 Then
                .Cells(k, 13) = .Cells(k, 7) - .Cells(k, 6)
            End If
        End With
        Прогресс = ПрогрессПоказать2(k, ШагПрогресса, Прогресс, n)
    Next k
    t3 = Format(Now, "Long Time")
    
    'очистим массив и словарь
    Erase Источник
    НашСловарь.RemoveAll
    Worksheets("результат").Cells(2, 14) = t1
    Worksheets("результат").Cells(2, 15) = t2
    Worksheets("результат").Cells(2, 16) = t3
    Unload UserForm1
    MsgBox ("Обработка завершена")
End Sub
-----------------------------------------------------
‘Далее дополнительные функции для отрисовки процесса обработки
Function ПрогрессПоказать1(a, b, c, d)
    If c = 0 Then
       c = c + b
    ElseIf a >= c Then
       UserForm1.Label1.Width = Int(300 * c / d)
       UserForm1.Label5.Caption = CStr(Int(c / d * 100)) + "%"
       UserForm1.Repaint
       c = c + b
    End If
    ПрогрессПоказать1 = c
End Function
---------------------------------------------------
Function ПрогрессПоказать2(a, b, c, d)
    If c = 0 Then
       c = c + b
    ElseIf a >= c Then
       UserForm1.Label2.Width = Int(300 * c / d)
       UserForm1.Repaint
       c = c + b
    End If
    ПрогрессПоказать2 = c
End Function

Обратите внимание, что перед использованием макроса следует проверить, включен ли у вас в Настройках VBA параметр MicrosoftScripting Runtime (см. рисунки ниже)

Вот так, используя несложные приемы можно быстро обработать данные и получить в удобном формате информацию, необходимую для анализа.