Как можно ускорить работу макроса Excel с большим кол-вом итерационных циклов?

@Kuznetsovka · Регистрация: 14.04.2015

Author24 — интернет-сервис помощи студентам

Есть задача, которую решил, но хотел бы ускорить работу. Проблема в том что суть программы пройти по строкам и столбцам в 1 таблице, сравнения с значениями в другой таблице, и если условие выполняется вписывать нужное значение в соответствующую ячейку, вот кусок проги:

Visual Basic

Set Result24 = ThisWorkbook.Worksheets("24h")
Set Result5_17 = ThisWorkbook.Worksheets("6h-18h")
Set Result17_5 = ThisWorkbook.Worksheets("18h-6h")
Set Arhiv = ThisWorkbook.Worksheets("Архив")
For i = 2 To Result24.UsedRange.Rows.Count
 For j = 2 To Result24.UsedRange.Columns.Count
   For z = 2 To Arhiv.UsedRange.Rows.Count
    If Result24.Cells(i, 1).Value = Arhiv.Cells(z, 4).Value _
     And Arhiv.Cells(z, 3).Value >= CInt(Mid(Result24.Cells(1, j).Value, 1, 3)) _
     And Arhiv.Cells(z, 3).Value <= CInt(Mid(Result24.Cells(1, j).Value, 5, 7)) Then
      Result24.Cells(i, j) = 3 + Result24.Cells(i, j)
    
      If Arhiv.Cells(z, 6).Value >= 5 And Arhiv.Cells(z, 6).Value <= 17 Then
      Result5_17.Cells(i, j) = 3 + Result5_17.Cells(i, j)
      End If
      
      If Arhiv.Cells(z, 6).Value >= 17 And Arhiv.Cells(z, 6).Value <= 5 Then
      Result17_5.Cells(i, j) = 3 + Result17_5.Cells(i, j)
      End If
      
    End If
   Next z
  Next j
 Next i

Работает прога в Excelе, пробовал сделать тоже в accessе скорость не улучшилась.
Количество циклов примерно равно: 30000 * 76 * 20 = 45,6 миллионов циклов. Скорость выполнения примерно 1.5-2 часа.

Подскажите, у кого какие идеи?

@Hugo121 · 14.01.2016, 18:43

1. если влезет всё в память - взять данные в массивы, перебирать их.
2. цепочку (все цепочки) AND преобразовать в лесенку IF-THEN, вглубь положить наиболее вероятное, снаружи наименее.

Добавлено через 30 минут
Ещё - вот это

Visual Basic

1 2	CInt(Mid(Result24.Cells(1, j).Value, 1, 3)) CInt(Mid(Result24.Cells(1, j).Value, 5, 7))

можно извлечь один раз перед циклом в две переменные, а не тратить время в цикле.

shanemac51 · 14.01.2016, 20:54

а это разве возможно

Visual Basic

1	If Arhiv.Cells(z, 6).Value >= 17 And Arhiv.Cells(z, 6).Value <= 5 Then

Добавлено через 1 час 9 минут
в былые времена я бы сделала так

Visual Basic

Sub Test160114()
Set Result24 = ThisWorkbook.Worksheets("24h")
Set Result5_17 = ThisWorkbook.Worksheets("6h-18h")
Set Result17_5 = ThisWorkbook.Worksheets("18h-6h")
Set Arhiv = ThisWorkbook.Worksheets("Архив")
 
Dim I24K, J24K, ZAK, I, J, Z
I24K = Result24.UsedRange.Rows.Count
J24K = Result24.UsedRange.Columns.Count
ZAK = Arhiv.UsedRange.Rows.Count
Dim M24_1_3, M24_5_7
ReDim M24_1_3(0 To J24K)
ReDim M24_5_7(0 To J24K)
For J = 2 To J24K
M24_1_3(J) = CInt(Mid(Result24.Cells(1, J).Value, 1, 3))
M24_5_7(J) = CInt(Mid(Result24.Cells(1, J).Value, 5, 7))
Next J
 
For I = 2 To I24K
For J = 2 To J24K
r24 = Result24.Cells(I, J)
R17_5 = Result17_5.Cells(I, J)
R5_17 = Result5_17.Cells(I, J)
 
For Z = 2 To ZAK
z4 = Arhiv.Cells(Z, 4).Value
z3 = Arhiv.Cells(Z, 3).Value
z6 = Arhiv.Cells(Z, 6).Value
 
If Result24.Cells(I, 1).Value = z4 Then
If z3 >= M24_1_3(J) And z3 <= M24_5_7(J) Then
r24 = 3 + r24
 
If z6 > 17 Or z6 < 5 Then
R17_5 = 3 + R17_5
Else
R5_17 = 3 + R5_17
End If
 
End If
End If
Next Z
 
Result24.Cells(I, J) = r24
Result17_5.Cells(I, J) = R17_5
Result5_17.Cells(I, J) = R5_17
 
 
Next J
Next I
End Sub

@Kuznetsovka · 15.01.2016, 09:44 **[ТС]**

Да, Вы правы, на самом деле там ИЛИ. Старый вариант кода.
If Arhiv.Cells(z, 6).Value >= 17 Or Arhiv.Cells(z, 6).Value <= 5 Then

Сообщение от shanemac51

в былые времена я бы сделала так

Спасибо за совет.
Суть уловил, но сомневаюсь, что это значительно ускорит процесс. Сегодня протестирую.

@Hugo121 · 15.01.2016, 09:47

Массивы ускорят раз так в 40.
Изменения с AND ускорят раза в 3.

shanemac51 · 15.01.2016, 12:25

В массив удобно списать лист АРХИВ --в него нет обратной записи, но сложность, если позиции R24 не окажется в в АРХИВ, что даст ошибку адресации

@Kuznetsovka · 19.01.2016, 12:13 **[ТС]**

Всем спасибо, после сегоднешнего теста вот что получилось: кол-во циклов: 50 668 800.
1. Прогнал свой вариант с разделениес If and на 2 if.
2. Прогнал предложенный вариант Sub Test160114().

Получил удивительный результат:
1. Время решения: 12:48.
2. Время решения: 24:33.

Разделение If and уменьшило время выполнения примерно в 3 раза.

@Hugo121 · 19.01.2016, 12:35

Всё логично - при AND всегда проводятся все проверки, указанные в строке, а при вложенных IF только нужные - если не прошла первая, то остальные не производятся. Если всё это ещё происходит с ячейками - разница будет заметна.

@Kuznetsovka 0 / 0 / 0 Регистрация: 14.04.2015 Сообщений: 6
	15.01.2016, 09:44 [ТС]	4
	Да, Вы правы, на самом деле там ИЛИ. Старый вариант кода. If Arhiv.Cells(z, 6).Value >= 17 Or Arhiv.Cells(z, 6).Value <= 5 Then Сообщение от shanemac51 в былые времена я бы сделала так Спасибо за совет. Суть уловил, но сомневаюсь, что это значительно ускорит процесс. Сегодня протестирую. 0

@Hugo121 6922 / 2832 / 543 Регистрация: 19.10.2012 Сообщений: 8,645
	15.01.2016, 09:47	5
	Массивы ускорят раз так в 40. Изменения с AND ускорят раза в 3. 0

shanemac51 Модератор 11963 / 4831 / 779 Регистрация: 07.08.2010 Сообщений: 14,151 Записей в блоге: 4
	15.01.2016, 12:25	6
	В массив удобно списать лист АРХИВ --в него нет обратной записи, но сложность, если позиции R24 не окажется в в АРХИВ, что даст ошибку адресации 0

@Kuznetsovka 0 / 0 / 0 Регистрация: 14.04.2015 Сообщений: 6
	19.01.2016, 12:13 [ТС]	7
	Всем спасибо, после сегоднешнего теста вот что получилось: кол-во циклов: 50 668 800. 1. Прогнал свой вариант с разделениес If and на 2 if. 2. Прогнал предложенный вариант Sub Test160114(). Получил удивительный результат: 1. Время решения: 12:48. 2. Время решения: 24:33. Разделение If and уменьшило время выполнения примерно в 3 раза. 0

@Hugo121 6922 / 2832 / 543 Регистрация: 19.10.2012 Сообщений: 8,645
	19.01.2016, 12:35	8
	Всё логично - при AND всегда проводятся все проверки, указанные в строке, а при вложенных IF только нужные - если не прошла первая, то остальные не производятся. Если всё это ещё происходит с ячейками - разница будет заметна. 0

Как можно ускорить работу макроса Excel с большим кол-вом итерационных циклов?

Решение