Добрый день, прошу помочь с сортировкой географических координат их гугловских карт. К примеру, если звять первую строку и считать её отправной точкой, то после сортировки за ней должна идти ближайшая к первой, затем ближайшая ко второй и так далее.
Спасибо за помощь.
Добрый день, прошу помочь с сортировкой географических координат их гугловских карт. К примеру, если звять первую строку и считать её отправной точкой, то после сортировки за ней должна идти ближайшая к первой, затем ближайшая ко второй и так далее.
где 6371,21 - радиус земли. Для сортировки на радиус земли можно не умножать. Далее сортируем Выделить A2:D10. Данные - Сортировка По столбцу расстояние, по возрастанию, Ок
где 6371,21 - радиус земли. Для сортировки на радиус земли можно не умножать. Далее сортируем Выделить A2:D10. Данные - Сортировка По столбцу расстояние, по возрастанию, ОкAlexM
Только в этом случае получается, что точки сортируются по удалённости от первоначальной, но я спрашивал немного другой вариант: после второй должна идти точка ближайшая ко второй, потом ближайшая к третьей, потом ближайшая к четрвёртой и т.д.
Вообще задача такая, что надо объехать много-много точек на карте и необходимо спланировать порядок объезда так, чтобы не ездить через весь город, в день планируется посещение порядка трёх точек. Можно в Вашем варианте править формулу в каждой четвёртой строке и сортировать заново все ниже лежащие, но это долго (точек порядка 100) и боюсь заупутаться. Можно это как-то автоматизировать?
Круто, очень...
Только в этом случае получается, что точки сортируются по удалённости от первоначальной, но я спрашивал немного другой вариант: после второй должна идти точка ближайшая ко второй, потом ближайшая к третьей, потом ближайшая к четрвёртой и т.д.
Вообще задача такая, что надо объехать много-много точек на карте и необходимо спланировать порядок объезда так, чтобы не ездить через весь город, в день планируется посещение порядка трёх точек. Можно в Вашем варианте править формулу в каждой четвёртой строке и сортировать заново все ниже лежащие, но это долго (точек порядка 100) и боюсь заупутаться. Можно это как-то автоматизировать?totkapf
Попробовал. В принципе что-то получается. С обильным использованием функции РАНГ и огромной решательной полуматрицей. Для уникальной однозначности РАНГ добавил в формулу номер строки (в 6-й разряд после запятой). Решение не окончательное, но показывающее направление. Надо еще будет собрать отсортированные координаты из первой строки матрицы. Если будет 100 пар координат, то по ширине листа в Excel 2003 не влезет, как минимум 2007.
Попробовал. В принципе что-то получается. С обильным использованием функции РАНГ и огромной решательной полуматрицей. Для уникальной однозначности РАНГ добавил в формулу номер строки (в 6-й разряд после запятой). Решение не окончательное, но показывающее направление. Надо еще будет собрать отсортированные координаты из первой строки матрицы. Если будет 100 пар координат, то по ширине листа в Excel 2003 не влезет, как минимум 2007.Gustav
На вид классическая задача коммивояжера. Нужно ли возвращатся в первоначальную точку? Нужно ли обязательно объезжать все точки?
Если точек не более 10-12, то оптимальный маршрут можно найти перебором всех возможных вариантов, если более 15, то перебор уже не подойдет. То что Вы описали по решению напоминает жадный алгоритм. Он подойдет если нет необходимости возвращатся в первоначальную точку. Если маршрут должен быть замкнутым, то можно еще попытатся решить методом ветвей и границ (методом Литтла) - но алгоритм достаточно сложный и его реализации на VBA у меня нет (но думал реализовать)
На вид классическая задача коммивояжера. Нужно ли возвращатся в первоначальную точку? Нужно ли обязательно объезжать все точки?
Если точек не более 10-12, то оптимальный маршрут можно найти перебором всех возможных вариантов, если более 15, то перебор уже не подойдет. То что Вы описали по решению напоминает жадный алгоритм. Он подойдет если нет необходимости возвращатся в первоначальную точку. Если маршрут должен быть замкнутым, то можно еще попытатся решить методом ветвей и границ (методом Литтла) - но алгоритм достаточно сложный и его реализации на VBA у меня нет (но думал реализовать)MCH
Gustav, спасибо вариант очень интересный, осталось только разобраться как вытаскивать собственно нумерацию, пока, как я понял, это только врчную работает, надо попробовать на всей матрице.
Ещё раз спасибо за ответ.
Gustav, спасибо вариант очень интересный, осталось только разобраться как вытаскивать собственно нумерацию, пока, как я понял, это только врчную работает, надо попробовать на всей матрице.
MCH, очень интересно, только не могу понять, почему, когда я добавлюя новые строки, даже поправив в формулах конечную строку, у меня всё слетает? Что я делаю не так?
MCH, очень интересно, только не могу понять, почему, когда я добавлюя новые строки, даже поправив в формулах конечную строку, у меня всё слетает? Что я делаю не так?totkapf
Без Вашего файла трудно сказать что не так, но нужно учитывать, что макрос ссылается на определенные ячейки, формулы и график тоже ссылаются на определенные диапазоны и т.д. Если не получается вставить данные самому, то приложите обновленный файл - поправим
Без Вашего файла трудно сказать что не так, но нужно учитывать, что макрос ссылается на определенные ячейки, формулы и график тоже ссылаются на определенные диапазоны и т.д. Если не получается вставить данные самому, то приложите обновленный файл - поправимMCH
Сообщение отредактировал MCH - Четверг, 10.07.2014, 14:54
Реализовал свой алгоритм сортировки в процедурном виде с использованием рекордсетов ADO в качестве массивов (их можно удобно фильтровать и сортировать в памяти). Стало всё намного компактнее и прозрачнее.
В качестве параметров процедуре надо передать исходный диапазон листа (2 колонки), содержащий координаты точек, а также указать диапазон вывода порядковых номеров сортировки (также вертикальный, 1 колонка). Удобно вывести порядковые номера в ближайший столбец, соседний с координатами, чтобы потом стандартно отсортироваться по этому столбцу. Первой строкой исходного диапазона должна быть выбранная точка отсчета (поэтому порядковый номер для первой строки всегда будет 1).
[vba]
Код
Sub sortGeoPoints(rngCoords As Range, rngSortOrder As Range)
Dim cnn As Object 'As ADODB.Connection Dim rst1 As Object 'As ADODB.Recordset Dim rst2 As Object 'As ADODB.Recordset Dim fieldList Dim x0 As Double Dim y0 As Double Dim i As Integer Dim sqlSource As String
Set cnn = CreateObject("ADODB.Connection") Set rst1 = CreateObject("ADODB.Recordset") Set rst2 = CreateObject("ADODB.Recordset")
With rst2.Fields .Append "F4", 3 'adInteger 'рассчитанный порядок сортировки - на 1-й позиции для удобства вывода на лист .Append "F1", 5 'adDouble 'координата X - широта .Append "F2", 5 'adDouble 'координата Y - долгота .Append "F3", 5 'adDouble 'расстояние между геоточками .Append "F5", 3 'adInteger 'исходный порядок сортировки End With rst2.Open
fieldList = Array("F1", "F2", "F3", "F4", "F5")
'формирование массива 2 i = 0 With rst1 .MoveFirst Do While Not .EOF i = i + 1 'запоминаем исходный порядок записей rst2.AddNew fieldList, Array(!F1, !F2, 0, 0, i) .MoveNext Loop End With
'обработка массива 2 i = 0 With rst2 Do i = i + 1 .MoveFirst x0 = !F1 y0 = !F2 .Update "F4", i
.Filter = "F4 = 0" Do While Not .EOF .Update "F3", dln(x0, y0, !F1, !F2) .MoveNext Loop rst2.Sort = "F3 ASC" 'сортируем по расстоянию Loop Until .RecordCount = 0
.Filter = "" .Sort = "F5 ASC" 'восстанавливаем исходный порядок .MoveFirst End With
rngSortOrder.CopyFromRecordset rst2, , 1 'вывод одной самой левой колонки
Реализовал свой алгоритм сортировки в процедурном виде с использованием рекордсетов ADO в качестве массивов (их можно удобно фильтровать и сортировать в памяти). Стало всё намного компактнее и прозрачнее.
В качестве параметров процедуре надо передать исходный диапазон листа (2 колонки), содержащий координаты точек, а также указать диапазон вывода порядковых номеров сортировки (также вертикальный, 1 колонка). Удобно вывести порядковые номера в ближайший столбец, соседний с координатами, чтобы потом стандартно отсортироваться по этому столбцу. Первой строкой исходного диапазона должна быть выбранная точка отсчета (поэтому порядковый номер для первой строки всегда будет 1).
[vba]
Код
Sub sortGeoPoints(rngCoords As Range, rngSortOrder As Range)
Dim cnn As Object 'As ADODB.Connection Dim rst1 As Object 'As ADODB.Recordset Dim rst2 As Object 'As ADODB.Recordset Dim fieldList Dim x0 As Double Dim y0 As Double Dim i As Integer Dim sqlSource As String
Set cnn = CreateObject("ADODB.Connection") Set rst1 = CreateObject("ADODB.Recordset") Set rst2 = CreateObject("ADODB.Recordset")
With rst2.Fields .Append "F4", 3 'adInteger 'рассчитанный порядок сортировки - на 1-й позиции для удобства вывода на лист .Append "F1", 5 'adDouble 'координата X - широта .Append "F2", 5 'adDouble 'координата Y - долгота .Append "F3", 5 'adDouble 'расстояние между геоточками .Append "F5", 3 'adInteger 'исходный порядок сортировки End With rst2.Open
fieldList = Array("F1", "F2", "F3", "F4", "F5")
'формирование массива 2 i = 0 With rst1 .MoveFirst Do While Not .EOF i = i + 1 'запоминаем исходный порядок записей rst2.AddNew fieldList, Array(!F1, !F2, 0, 0, i) .MoveNext Loop End With
'обработка массива 2 i = 0 With rst2 Do i = i + 1 .MoveFirst x0 = !F1 y0 = !F2 .Update "F4", i
.Filter = "F4 = 0" Do While Not .EOF .Update "F3", dln(x0, y0, !F1, !F2) .MoveNext Loop rst2.Sort = "F3 ASC" 'сортируем по расстоянию Loop Until .RecordCount = 0
.Filter = "" .Sort = "F5 ASC" 'восстанавливаем исходный порядок .MoveFirst End With
rngSortOrder.CopyFromRecordset rst2, , 1 'вывод одной самой левой колонки
MCH, я добалил в файл новую строку "Новая запись", в Исходные данные, ввёл в неё реальные координаты. Потом добавил с таблицу рядом, поправил ссылки и диапазоны, но по кнопке Случайно программа возвращает ошибку. Вроде всё проверил, все ссылки, но что-то не так
MCH, я добалил в файл новую строку "Новая запись", в Исходные данные, ввёл в неё реальные координаты. Потом добавил с таблицу рядом, поправил ссылки и диапазоны, но по кнопке Случайно программа возвращает ошибку. Вроде всё проверил, все ссылки, но что-то не такtotkapf
Попытка найти решение случайным образом уже для 20 точек не получается, сделал решение графическим способом. Решение не всегда может быть оптимальным, но близкое к таковому, при этом скорость решения очень большая
Попытка найти решение случайным образом уже для 20 точек не получается, сделал решение графическим способом. Решение не всегда может быть оптимальным, но близкое к таковому, при этом скорость решения очень большаяMCH
Шикарное решение MCH На сколько я понял алгоритм - расчет идет по расположению... т.е. нахождение точек внутри многоугольника. Похожее решение видел на немецком форуме(файл внутри)... там тоже расчет связан с графиком. У этого подхода есть один недостаток - он производит расчет по прямой... а натуральное расстояние может в разы отличатся(например точки А и Б находятся на разных берегах, и чтобы доехать из А в Б - можно по пути проехать несколько точек (В,Г,Д) - тогда будет не АБВГД а АВГДБ). Мы с Вами уже обсуждали тему здесь, но в этой теме она обсуждается активней Может можно как-то связать то что Вы сделали с матрицей реальных расстояний? Чтобы показывало действительно наилучший и реальный результат. Думаю может какую-то перепроверку по прилегающим квадратам или точкам, чтобы не перебирать все точки?
Шикарное решение MCH На сколько я понял алгоритм - расчет идет по расположению... т.е. нахождение точек внутри многоугольника. Похожее решение видел на немецком форуме(файл внутри)... там тоже расчет связан с графиком. У этого подхода есть один недостаток - он производит расчет по прямой... а натуральное расстояние может в разы отличатся(например точки А и Б находятся на разных берегах, и чтобы доехать из А в Б - можно по пути проехать несколько точек (В,Г,Д) - тогда будет не АБВГД а АВГДБ). Мы с Вами уже обсуждали тему здесь, но в этой теме она обсуждается активней Может можно как-то связать то что Вы сделали с матрицей реальных расстояний? Чтобы показывало действительно наилучший и реальный результат. Думаю может какую-то перепроверку по прилегающим квадратам или точкам, чтобы не перебирать все точки?SLAVICK