Добрый день, написав калькулятор расстояний между пунктами столкнулся с необходимостью получения расстояний между большим числом городов. написал макрос, но для большого объема он слишком медленный. Подскажите, как его ускорить, или может его стоит написать через массив как-то? Я новичок в макросах, прошу не судить строго. файл с примером прикрепляю (поле, в котором выдается резульат-расстояние считается намного сложнее чем в примере, поэтому просто прибавлять 25 к найденному значению не подойдет), макрос представлен ниже. Перед началом макросах выделяю ячейки а3:b3 и запускаю:
Код
Sub test()
Application. ScreenUpdating = False
Dim intcount = 1 As long
For intcount = 1 to Cells(1, 1)
Selection. Copy
Sheets("Расчет").Range("B2").Pastespecial Paste:=x1PasteValues, Operation:=x1None, SkipBlanks _ :=False, Transponse:=False
Sheets("Расчет").Range("f1").Copy
Sheets("Macros").Select
Activecell.Offset(0, 2).Pastespecial Paste:=x1PasteValues, Operation:=x1None, SkipBlanks _ :=False, Transponse:=False
Range("Activecell.Offset(1, -1), Activecell.Offset(1, -2)).Select
Next
Application. ScreenUpdating = True
End Sub
Я переделал вашу таблицу и предлагаю попробовать сделать через UDF.
Потенциальная проблема: если поменять значения в таблице с расстояниями (или тарифами?), то значения сами автоматом не пересчитаются. Нужно будет зайти на вкладку формулы и нажать кнопку "пересчитать"
Grantorino, вот из-за этого "забирать результат из F1" оно и тормозит. Эксель считает-то быстро, но данные в ячейки копирует туда-сюда медленно. Сейчас попробую Ваш макрос подправить. Может ускорится...
+Какие проблемы я заметил в Вашем варианте: 1. Словарь не будет работать (в первом столбце повторяются значения Смоленск, ПОИСКПОЗ находит только первое значение, то есть Красный Бор и Великий Устюг не найдутся) 2. Смоленск-Гусино и Гусино-Смоленск это разные направления и их придётся вносить в таблицу отдельно.
Sub test1()
Application.ScreenUpdating = False
Dim intcount As Long
Dim rngX As Range
Set rngX = Cells(Selection.Row, 1).Resize(1, 2)
For intcount = 1 To Cells(1, 1)
Sheets("Расчет").Range("B2:C2").Value = rngX.Value
rngX.Offset(, 2).Resize(1, 1).Value = Sheets("Расчет").Range("f1").Value
Set rngX = rngX.Offset(1)
Next
Application.ScreenUpdating = True
End Sub
Wiss, Ваш последний макрос прекрасен, в 7 раз быстрее моего ( 7 секунд на 1000 значений против 50 сек.), большое спасибо! Буду пробовать его на большем массиве.
А если полученный результат вносить не как сейчас, в тоскую таблицу, а в матрицу, то быстрее не станет?
Я сделал калькулятор рассчитывающий расстояние между остановками, таковых остановок более двух тысяч. Теперь, после того как я сделал калькулятор, хочу получить матрицу (или таблицу) между всеми остановками, т.е. расстояние от каждой до каждой. Калькулятор это не просто сложение двух чисел, а довольно объемный инструмент, поэтому вариант с созданием формулы к сожалению не подходит. Поэтому и возникла потребность в проведении через калькулятор всех вариантов.