Более быстрый способ расчета расстояния между двумя точками (почтовые индексы)

Question

Я пишу сценарий VBA, который находит почтовые индексы внутри указанного радиуса.У меня есть база данных доступа с несколькими записями в таблице.Каждая запись имеет в таблице имя, адрес и почтовый индекс.Код VBA при доступе запрашивает у пользователя почтовый индекс и радиус поиска, а затем вычисляет расстояние между пользовательским почтовым индексом и почтовым индексом для каждой записи.После расчета каждого расстояния запись отображается в форме, пока она попадает в поле ввода радиуса.

Код, который я написал, работает, но время выполнения занимает слишком много времени (около 30 секунд для 2000-записей).Как я могу уменьшить время, необходимое для выполнения этого кода VBA?Вот код, который я написал:

Private Sub Command65_Click()
Dim StartTime As Double
Dim SecondsElapsed As Double
Dim i, j As Integer
Dim db As Database
Dim rs As Recordset
Dim ZIP, r As Double
Dim arr(33144, 3) As Double
Dim lat1, long1, lat2, long2, theta As Double
Dim Distance As Integer
Dim deg2rad, rad2deg As Double
Const PI As Double = 3.14159265359
'Dim Variables

StartTime = Timer
deg2rad = PI / 180
rad2deg = 180 / PI

r = Text1.Value
ZIP = Text2.Value
'Get radius and prompted zip code from form

Set db = CurrentDb
Set rs = db.OpenRecordset("US Zip Codes")
'Open the Table named "US Zip Codes"

For i = 0 To 33143
    arr(i, 0) = rs.Fields("ZIP")
    arr(i, 1) = rs.Fields("LAT")
    arr(i, 2) = rs.Fields("LNG")
    rs.MoveNext
Next i
'Loop through each Zip Code record and store the Zip Code, Lattitude Point, and Longitude Point to an array

For i = 0 To 33143
    If ZIP = arr(i, 0) Then
        lat1 = arr(i, 1) * deg2rad
        long1 = arr(i, 2) * deg2rad
    End If
Next i
'Loop through the zip code array to get Zip Code's corresponding LAT and LONG

Set rs = db.OpenRecordset("Clinics")
'Open the Table named "Clinics"

For j = 0 To 2094
    If rs("Clinic ZIP") = ZIP Then
        Distance = 0
        'If Zip Code 1 and Zip Code 2 are equal to each other, Distance = 0
    ElseIf rs("Clinic ZIP") <> "" Then
        zip2 = rs("Clinic ZIP")
        For i = 0 To 33143
            If zip2 = arr(i, 0) Then
                lat2 = arr(i, 1) * deg2rad
                long2 = arr(i, 2) * deg2rad
            End If
        Next i
        'Loop through the zip code array to get the second Zip Code's corresponding LAT and LONG
        theta = long1 - long2
        Distance = ArcCOS(Sin(lat1) * Sin(lat2) + Cos(lat1) * Cos(lat2) * Cos(theta)) * rad2deg * 60 * 1.1515
        'Calculate Distance between the two zip codes
    Else
        Distance = 999
        'Set Arbitrary Value if the zip code field is empty
    End If
    rs.Edit
    rs.Fields("Distance") = Distance
    rs.Update
    rs.MoveNext
Next j

Me.Filter = "Distance<=" & r
Me.FilterOn = True
'Filter the table with calculated distance by prompted radius
Forms("Zip Search").Requery
rs.Close
Set rs = Nothing
db.Close

SecondsElapsed = Round(Timer - StartTime, 2)
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation

End Sub

Answer 1

Я только что провел тест с таблицей из 1976 ресторанов:

ID  lon        lat       poi_name                                     
--  ---------  --------  ---------------------------------------------
 1   -114.063   51.0466  Palomino Smokehouse: Calgary, AB             
 2   -114.055   51.0494  Bookers BBQ Grill and Crab Shack: Calgary, AB
 3  -86.97871  34.58037  Big Bob Gibson's Original: Decatur, AL       
 4  -87.01763  34.56587  Big Bob Gibson's #2: Decatur, AL             
 5    -86.364  32.26995  DJ's Old Post Office: Hope Hull, AL          
...

Используя функцию GreatCircleDistance, доступную из ...

http://www.cpearson.com/excel/LatLong.aspx

... Я выполнил следующий запрос, чтобы вычислить расстояние от заданной точки

PARAMETERS prmLon IEEEDouble, prmLat IEEEDouble;
SELECT BBQ2.ID, BBQ2.lon, BBQ2.lat, BBQ2.poi_name, 
    GreatCircleDistance([prmLat],[prmLon],[lat],[lon],True,False) AS km
FROM BBQ2;

, и результаты вернулись менее чем за секунду.

Затем, чтобы вернуть результаты в пределах определеннойколичество километров от заданной точки, которое я использовал

PARAMETERS prmLon IEEEDouble, prmLat IEEEDouble, prmWithinKm IEEEDouble;
SELECT * FROM
(
    SELECT BBQ2.ID, BBQ2.lon, BBQ2.lat, BBQ2.poi_name, 
        GreatCircleDistance([prmLat],[prmLon],[lat],[lon],True,False) AS km
    FROM BBQ2
)
WHERE km <= [prmWithinKm];

и снова результаты вернулись менее чем за секунду.

Answer 2

Применяя комментарии для пересмотра кода, рассмотрите следующие, которые предполагают, что ArcCos () является общедоступной пользовательской UDF.Кроме того, два объекта запроса упоминаются как источники данных.Одним из них является запрос к таблице ZipCodes, которая вычисляет значения lat и long.Другой - это запрос, который соединяет таблицу Clinics с вышеуказанным запросом.

Private Sub Command65_Click()
Dim StartTime As Double
Dim lat1 As Double, long1 As Double
Dim Distance As Integer
'Dim Variables

StartTime = Timer

lat1 = DLookup("lat", "qryLatLongZip", "Zip='" & Me.Text2 & "'")
long1 = DLookup("long", "qryLatLongZip", "Zip='" & Me.Text2 & "'")

CurrentDb.Execute "UPDATE qryClinicsLatLongZip SET Distance = ArcCos(Sin(" & lat1 & ") * Sin(lat) + Cos(" & lat1 & ") * Cos(lat) * Cos(" & long1 & "-long)) * (180 / 3.14159265359) * 60 * 1.1515"

Me.Filter = "Distance<=" & Me.Text1
Me.FilterOn = True
'Filter the form with calculated distance by prompted radius

MsgBox "This code ran successfully in " & Round(Timer - StartTime, 2) & " seconds", vbInformation

End Sub

Однако в многопользовательской базе данных пользователи конфликтуют друг с другом, записывая расстояние до общей таблицы.Если существует несколько пользователей, то необходимо разделить базу данных и создать временную таблицу (таблица является постоянной, записи являются временными) во внешнем интерфейсе для записи записей, и это будет отчет RecordSource.Решение, позволяющее избежать редактирования / сохранения записей, было бы наиболее желательным, и теперь я вижу, что был получен ответ именно на это.