Добрый день, я в VBA ноль, подсмотрел в разных источниках и написал макрос, но написал с ошибками, а так как не понимаю в VBA то и ошибку найти не могу. Помогите пожалуйста.
Что хотел сделать:
генератор маршрутных листов
на входе в макрос километраж, количество дней, список адресов с приоритетами и расстоянием до них.
На выходе список адресов по дням с километражом.
Как пытался вычислить:
взять километраж "killometrag" и разделить его на количество дней "day", чтобы цифры были не одинаковыми рандомно прибавить или отнять рандомное число, которое будет прописано в ячейке "разброс".
Затем проверить, что сумма километров за эти дне не превысит общий километраж из ячейки "killometrag".
Так я получу сколько километров в день проехали.
Затем я беру из массива "rastoyniy" рандомные числа и проверяю, чтобы сумма этих чисел была равна километражу за день. Числа берутся не совсем рандомно, у каждого числа есть вес, который указан в третьем столбце массива, чем выше число тем выше приоритет этой ячейки попасть в выборку, чем у других.
Если сумма больше километражу за день, цикл начинается по новой.
Получив нужную сумму я извлекаю адреса строк, вписываю в ячейку с именем "spisok". Так я повторяю до тех пор пока не заполню строки по количеству дней.
Sub RandomCells()
Dim day As Integer 'переменная для хранения значения ячейки "day"'
Dim kalendar() As Variant 'объявляем массив kalendar'
Dim rastoyniy() As Variant 'объявляем массив rastoyniy'
Dim killometrag As Integer 'переменная для хранения значения ячейки "killometrag"'
Dim razbros As Integer 'переменная для хранения значения ячейки "razbros"'
Dim mini_rashojdenie As Integer 'переменная для хранения значения ячейки "mini_rashojdenie"'
'задаем значения переменных'
' Получаем значения из ячеек
day = Range("day").Value
killometrag = Range("killometrag").Value
razbros = Range("razbros").Value
mini_rashojdenie = Range("mini_rashojdenie").Value
' Создаем массив kalendar
ReDim kalendar(1 To day, 1 To 3)
' Массив kalendar выведем в ячейку spisok
Range("spisok").Resize(dayCount, 1).Value = kalendar
' Заполняем первый столбец массива kalendar рандомными числами
Dim i As Integer
Dim summa As Integer
For i = 1 To day
kalendar(i, 1) = Int(Rnd() * (killometrag/day)) + 1 'здесь можно изменить диапазон случайных чисел
summa = summa + kalendar(i, 1)
Next i
' Выполняем проверку на разброс значений в первом столбце массива kalendar
Dim raznost As Integer
Dim r As Integer
Dim p As Integer
Dim modified As Boolean
While True
raznost = 0
modified = False
For r = 1 To day - 1
For p = r + 1 To day
If Abs(kalendar(r, 1) - kalendar(p, 1)) > razbros Then
raznost = raznost + 1
kalendar(r, 1) = Int(Rnd() * killometrag) + 1
modified = True
End If
Next p
Next r
' Если разброс удовлетворительный или не было изменений, выходим из цикла
If raznost = 0 Or Not modified Then
Exit While
End If
Wend
' Создаем массив rastoyniy
Dim last_row As Integer
last_row = Cells(Rows.Count, 1).End(xlUp).Row
ReDim rastoyniy(1 To last_row, 1 To 3)
For i = 1 To last_row
rastoyniy(i, 1) = Cells(i, 1).Value
rastoyniy(i, 2) = Cells(i, 2).Value
rastoyniy(i, 3) = Cells(i, 3).Value
Next i
' Выбираем случайную ячейку из массива rastoyniy вторым столбцом
Dim rast_summa As Integer
rast_summa = 0
Dim current_row As Integer
current_row = Int(Rnd() * last_row) + 1
Do While rast_summa + rastoyniy(current_row, 2) <= kalendar(1, 1) - mini_rashojdenie
' Заполняем ячейки массива kalendar соответствующими значениями
kalendar(1, 2) = rastoyniy(current_row, 1)
kalendar(1, 3) = kalendar(1, 3) + rastoyniy(current_row, 2)
rast_summa = rast_summa + rastoyn
' выбираем ячейку из массива rastoyniy
Set vybor = rastoyniy.Cells(intVybor, 1)
' увеличиваем счетчик выбора данной ячейки
vybor.Offset(0, 2).Value = vybor.Offset(0, 2).Value + 1
' добавляем выбранное значение в массив kalendar
kalendar(intI, 1) = vybor.Offset(0, 1).Value
kalendar(intI, 2) = vybor.Offset(0, 2).Value
' добавляем значение в третий столбец kalendar
kalendar(intI, 3) = kalendar(intI, 3) + vybor.Offset(0, 2).Value
' вычисляем разницу между последним выбранным числом
' и суммой чисел в массиве kalendar
intRaznica = km - WorksheetFunction.Sum(Columns(2).Resize(intI, 1))
если сумма чисел в массиве превышает km - mini_rashojdenie
' то начинаем выбор с начала
If intRaznica < mini_rashojdenie Then
intI = 0
Set kalendar = Nothing
Set kalendar = CreateObject("System.Collections.ArrayList")
kalendar.Capacity = day
GoTo start_kalendar
End If
' переходим к следующей строке в массиве kalendar
intI = intI + 1
Next intI
' выводим значения из массива kalendar в лист
Range("K20:M" & day + 1).Value = kalendar.ToArray()
End Sub