Страницы: 1
RSS
Сбор результатов выдаваемых калькулятором расстояний
 
Добрый день, написав калькулятор расстояний между пунктами столкнулся с необходимостью получения расстояний между большим числом городов.
написал макрос, но для большого объема он слишком медленный. Подскажите, как его ускорить, или  может его стоит написать через массив как-то? Я новичок в макросах, прошу не судить строго.
файл с примером прикрепляю (поле, в котором выдается резульат-расстояние считается намного сложнее чем в примере, поэтому просто прибавлять 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
Изменено: Grantorino - 14.01.2020 11:35:09
 
Я переделал вашу таблицу и предлагаю попробовать сделать через UDF.

Потенциальная проблема: если поменять значения в таблице с расстояниями (или тарифами?), то значения сами автоматом не пересчитаются. Нужно будет зайти на вкладку формулы и нажать кнопку "пересчитать"
Изменено: Wiss - 14.01.2020 11:29:02
Я не волшебник, я только учусь.
 
Большое спасибо!
Но как быть если необходимо забирать результат именно из ячейки F1?
Изменено: Grantorino - 14.01.2020 11:40:22
 
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 - 14.01.2020 11:54:38
Я не волшебник, я только учусь.
 
Wiss, Ваш последний макрос прекрасен, в 7 раз быстрее моего ( 7 секунд на 1000 значений против 50 сек.), большое спасибо!
Буду пробовать его на большем массиве.

А если полученный результат вносить не как сейчас, в тоскую таблицу, а в матрицу, то быстрее не станет?
 
Wiss, скажите, а если полученный результат вносить не как сейчас, в тоскую таблицу, а в матрицу, то быстрее не станет?  
 
Grantorino,
а вы можете объяснить что конкретно нужно, ибо для меня пока ваши макросы выглядят достаточно бессмысленными.
 
Dima S, да, конечно могу.

Я сделал калькулятор рассчитывающий расстояние между остановками, таковых остановок более двух тысяч.
Теперь, после того как я сделал калькулятор, хочу получить матрицу (или таблицу) между всеми остановками,  т.е. расстояние от каждой до каждой.
Калькулятор это не просто сложение двух чисел, а довольно объемный инструмент, поэтому вариант с созданием формулы к сожалению не подходит.
Поэтому и возникла потребность в проведении через калькулятор всех вариантов.
Страницы: 1
Наверх