#vba #loops #optimization
Вопрос:
Я запускаю приведенный ниже код, и на его выполнение уходит около 8 часов. Он выбирает 20 проектов (из 38), максимизируя полезность проектов при сохранении бюджетных ограничений. Существует также ограничение на минимальное/максимальное количество проектов класса A, класса B и класса A и класса B вместе взятых.
Код работает нормально, однако для его завершения требуется много времени. Знаете ли вы, как оптимизировать этот код, чтобы он работал быстрее (если это возможно)?
»’
Sub CalculateOptions()
Dim InputProjects(1 To 38, 4) As Single
Dim TopChoices(1 To 5, 1 To 22) As Single
Dim CurrentChoice(1 To 22) As Single
TotalHorInArray = 22
TotalVertInArray = 5
MinimalProjectsClassA = 9
MaximalProjectsClassA = 14
MinimalProjectsClassB = 5
MaximalProjectsClassB = 9
MinimalProjectsClassAandClassB = 15
MaximalProjectsClassAandClassB = 19
Budget = 49
NumberOfProjects = 38
'Read input
For x = 1 To NumberOfProjects
For y = 1 To 4
InputProjects(x, y) = Cells(2 x, 4 y)
Next
Next
For a = 1 To NumberOfProjects
For b = a 1 To NumberOfProjects
For c = b 1 To NumberOfProjects
For d = c 1 To NumberOfProjects
For e = d 1 To NumberOfProjects
For f = e 1 To NumberOfProjects
For g = f 1 To NumberOfProjects
For h = g 1 To NumberOfProjects
For i = h 1 To NumberOfProjects
For j = i 1 To NumberOfProjects
For k = j 1 To NumberOfProjects
For l = k 1 To NumberOfProjects
For m = l 1 To NumberOfProjects
For n = m 1 To NumberOfProjects
For o = n 1 To NumberOfProjects
For p = o 1 To NumberOfProjects
For q = p 1 To NumberOfProjects
For r = q 1 To NumberOfProjects
For s = r 1 To NumberOfProjects
For t = s 1 To NumberOfProjects
' Utility
UtilityChoice = InputProjects(a, 1) _
InputProjects(b, 1) _
InputProjects(c, 1) _
InputProjects(d, 1) _
InputProjects(e, 1) _
InputProjects(f, 1) _
InputProjects(g, 1) _
InputProjects(h, 1) _
InputProjects(i, 1) _
InputProjects(j, 1) _
InputProjects(k, 1) _
InputProjects(l, 1) _
InputProjects(m, 1) _
InputProjects(n, 1) _
InputProjects(o, 1) _
InputProjects(p, 1) _
InputProjects(q, 1) _
InputProjects(r, 1) _
InputProjects(s, 1) _
InputProjects(t, 1)
' Check if utility constraint is met (only want to show the top 5 combinations in the output)
If UtilityChoice > max5 Then
' Budget
budgetChoice = InputProjects(a, 3) _
InputProjects(b, 3) _
InputProjects(c, 3) _
InputProjects(d, 3) _
InputProjects(e, 3) _
InputProjects(f, 3) _
InputProjects(g, 3) _
InputProjects(h, 3) _
InputProjects(i, 3) _
InputProjects(j, 3) _
InputProjects(k, 3) _
InputProjects(l, 3) _
InputProjects(m, 3) _
InputProjects(n, 3) _
InputProjects(o, 3) _
InputProjects(p, 3) _
InputProjects(q, 3) _
InputProjects(r, 3) _
InputProjects(s, 3) _
InputProjects(t, 3)
' Check if budget constraint is met
If budgetChoice <= Budget Then
' Check number of projects per Class
ClassOfProject = InputProjects(a, 4) _
InputProjects(b, 4) _
InputProjects(c, 4) _
InputProjects(d, 4) _
InputProjects(e, 4) _
InputProjects(f, 4) _
InputProjects(g, 4) _
InputProjects(h, 4) _
InputProjects(i, 4) _
InputProjects(j, 4) _
InputProjects(k, 4) _
InputProjects(l, 4) _
InputProjects(m, 4) _
InputProjects(n, 4) _
InputProjects(o, 4) _
InputProjects(p, 4) _
InputProjects(q, 4) _
InputProjects(r, 4) _
InputProjects(s, 4) _
InputProjects(t, 4) 10
ProjectsClassA = Right(ClassOfProject, 2) - 10
ProjectsClassB = Round(ClassOfProject / 100, 0)
ProjectsClassAorB = ProjectsClassA ProjectsClassB
' Check if minumum and maximum constraint is satisfied for total projects of class A and B
If ProjectsClassA >= MinimalProjectsClassA And ProjectsClassA <= MaximalProjectsClassA _
And ProjectsClassB >= MinimalProjectsClassB And ProjectsClassB <= MaximalProjectsClassB And _
ProjectsClassAorB >= MinimalProjectsClassAandClassB And ProjectsClassAorB <= MaximalProjectsClassAandClassB Then
' Project specifics
CurrentChoice(1) = InputProjects(a, 2)
CurrentChoice(2) = InputProjects(b, 2)
CurrentChoice(3) = InputProjects(c, 2)
CurrentChoice(4) = InputProjects(d, 2)
CurrentChoice(5) = InputProjects(e, 2)
CurrentChoice(6) = InputProjects(f, 2)
CurrentChoice(7) = InputProjects(g, 2)
CurrentChoice(8) = InputProjects(h, 2)
CurrentChoice(9) = InputProjects(i, 2)
CurrentChoice(10) = InputProjects(j, 2)
CurrentChoice(11) = InputProjects(k, 2)
CurrentChoice(12) = InputProjects(l, 2)
CurrentChoice(13) = InputProjects(m, 2)
CurrentChoice(14) = InputProjects(n, 2)
CurrentChoice(15) = InputProjects(o, 2)
CurrentChoice(16) = InputProjects(p, 2)
CurrentChoice(17) = InputProjects(q, 2)
CurrentChoice(18) = InputProjects(r, 2)
CurrentChoice(19) = InputProjects(s, 2)
CurrentChoice(20) = InputProjects(t, 2)
CurrentChoice(21) = UtilityChoice
CurrentChoice(22) = budgetChoice
' Read in project specifics if utility is in the top 5 (and constraints above are met)
If UtilityChoice > max1 Then
max5 = max4
max4 = max3
max3 = max2
max2 = max1
max1 = UtilityChoice
For Z = 1 To TotalHorInArray
TopChoices(5, Z) = TopChoices(4, Z)
TopChoices(4, Z) = TopChoices(3, Z)
TopChoices(3, Z) = TopChoices(2, Z)
TopChoices(2, Z) = TopChoices(1, Z)
TopChoices(1, Z) = CurrentChoice(Z)
Next
ElseIf UtilityChoice > max2 Then
max5 = max4
max4 = max3
max3 = max2
max2 = UtilityChoice
For Z = 1 To TotalHorInArray
TopChoices(5, Z) = TopChoices(4, Z)
TopChoices(4, Z) = TopChoices(3, Z)
TopChoices(3, Z) = TopChoices(2, Z)
TopChoices(2, Z) = CurrentChoice(Z)
Next
ElseIf UtilityChoice > max3 Then
max5 = max4
max4 = max3
max3 = UtilityChoice
For Z = 1 To TotalHorInArray
TopChoices(5, Z) = TopChoices(4, Z)
TopChoices(4, Z) = TopChoices(3, Z)
TopChoices(3, Z) = CurrentChoice(Z)
Next
ElseIf UtilityChoice > max4 Then
max5 = max4
max4 = UtilityChoice
For Z = 1 To TotalHorInArray
TopChoices(5, Z) = TopChoices(4, Z)
TopChoices(4, Z) = CurrentChoice(Z)
Next
ElseIf UtilityChoice > max5 Then
max5 = UtilityChoice
For Z = 1 To TotalHorInArray
TopChoices(5, Z) = CurrentChoice(Z)
Next
End If
End If
End If
End If
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
' Write output to excel
For x = 1 To TotalVertInArray
For y = 1 To TotalHorInArray
Range("OutputCalculation").Offset(x, y) = TopChoices(x, y)
Next
Next
Range("A1").Select
End Sub
»’
Спасибо,
Вальтер
Комментарии:
1. В разделе «Запись выходных данных в excel» вы можете просто поместить массив в диапазон. Вы знаете, где его задерживают? Занимает ли время до «Записи выходных данных в excel», например, 1-й выходной?
2. С такой глубиной цикла удивительно, что запуск вашего кода занимает всего несколько часов. Лучший способ повысить производительность-выбросить этот код и использовать радикально иной подход, который использует решатель для решения хорошо сформулированной задачи дискретной оптимизации. Проблема не кажется огромной (с точки зрения исследования операций). Лучший подход может занять всего несколько секунд.
3. Поскольку только на самой внутренней итерации
tпроисходит изменение, вы можете разместить все остальные обращения за пределами этого цикла. Продолжайте со следующим самым внутренним циклом. Немного размышлений должно привести к более эффективному коду.4. Я не хотел показаться таким резким в своем последнем комментарии, но основная проблема заключается в том, что ваш основной алгоритм-это поиск методом перебора с(38,20) = 33,6 миллиарда возможностей. Несомненно, вы могли бы сделать этот поиск грубой силы более эффективным поиском грубой силы, но 33,6 миллиарда-это все равно 33,6 миллиарда, а VBA не демон скорости. С другой стороны, это задача целочисленного программирования 0-1 такого рода, с которой решатель может справиться с помощью сложных алгоритмов, реализованных в чем-то вроде C. Если вы хотите действительно значительного ускорения, вам действительно нужен совсем другой подход.
5. Совет искать лучшее решение вполне обоснован. Однако в этом случае вы говорите, что ваш код работает, вам просто нужно, чтобы он работал быстрее. В таком случае я бы рекомендовал взглянуть на twinbasic. Тем временем установите бесплатную и фантастическую надстройку Rubberduck для VBA и внимательно ознакомьтесь с проверками кода, которые она предоставляет.