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