Pour ma part, j'ai calculé les distances orthodromiques sur la base d'un rayon terrestre moyen de 6371 km. Je n'ai pas creusé la question de la pertinence de ce choix. Peut-être faut-il raffiner...(...)
Un point secondaire à signaler, les distances calculées par les 2 méthodes
diffèrent, je vais chercher le pourquoi, mais ma demande initiale est obtenue.
(...)
j'ai effectivement cherché l'optimisation.(...)
NB: J'ai du mal à voir comment on pourrait faire pour gagner du temps d'exécution sur ton programme, Roger, tant il me semble qu'il est déjà terriblement optimisé! (sur mon bouzin, ça prend environ 7mn et 40s)
(...)
Option Explicit
Sub proche() "modifié
Const P# = 3.14159265358978, P2# = 1.5707963267949, Pid# = 1.74532925199433E-02
Dim U&, V&, i&, j&, k&, L#, m#, D#, C#, S#, Ref(), Pos(), Trg#(), Equ()
Dim MaxSec As Double, T1 '++
T1 = Timer '++
MaxSec = 100 / 40000 * 360 '++ 100km ==> 0.9 seconde
Ref = Range(Cells(2, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 7)).Value ' ville, Ref, U
Pos = Range(Cells(2, 7), Cells(Cells(Rows.Count, 5).End(xlUp).Row, 8)).Value ' PI, Pos, V
U = UBound(Ref)
V = UBound(Pos)
ReDim Trg(1 To U, 2)
ReDim Equ(1 To V, 2)
For i = 1 To U
Trg(i, 0) = Ref(i, 4) * Pid
Trg(i, 1) = Cos(Ref(i, 3) * Pid)
Trg(i, 2) = Sin(Ref(i, 3) * Pid)
Next
For i = 1 To V
k = 0
m = 0
L = Pos(i, 2) * Pid
C = Cos(Pos(i, 1) * Pid)
S = Sin(Pos(i, 1) * Pid)
For j = 1 To U
If (Abs(Ref(j, 3) - Pos(i, 1)) < MaxSec) And (Abs(Ref(j, 4) - Pos(i, 2)) < MaxSec) Then '++
D = C * Trg(j, 1) * Cos(L - Trg(j, 0)) + S * Trg(j, 2)
If Abs(D) = 1 Then D = (Sgn(D) - 1) * P Else D = Atn(-D / Sqr(1 - D * D))
If D < m Then m = D: k = j
End If '++
Next
If k <> 0 Then '++
Equ(i, 0) = Ref(k, 2)
Equ(i, 1) = Ref(k, 1)
Equ(i, 2) = Round(6371 * (m + P2), 1)
End If '++
Next
Range(Cells(2, 9), Cells(Cells(Rows.Count, 5).End(xlUp).Row, 11)).Value = Equ
MsgBox Format(Timer - T1, "0,00 sec")
End Sub
Sub PI_alea() 'modifié
Dim i&, n&, PIal(), m&
n = 20000
ReDim PIal(1 To n, 3)
Randomize
For i = 1 To n
n = 2 + Rnd * 36570
m = 2 + Rnd * 36570
PIal(i, 0) = Cells(n, 1)
PIal(i, 1) = Cells(m, 1)
PIal(i, 2) = (Cells(n, 3) + Cells(m, 3)) / 2
PIal(i, 3) = (Cells(n, 4) + Cells(m, 4)) / 2
Next
Range(Cells(2, 5), Cells(i, 8)).Value = PIal
End Sub
Sub proche()
Const P# = 3.14159265358978, P2# = 1.5707963267949, Pid# = 1.74532925199433E-02, Ra# = 0.015707963267949, Ro# = 1.11072073453959E-02
Dim U&, V&, i&, j&, k&, L#, m#, D#, C#, S#, Ref(), Pos(), Trg#(), Equ(), N#
Ref = Range(Cells(2, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 7)).Value
Pos = Range(Cells(2, 7), Cells(Cells(Rows.Count, 5).End(xlUp).Row, 8)).Value
U = UBound(Ref)
V = UBound(Pos)
ReDim Trg(1 To U, 3)
ReDim Equ(1 To V, 2)
For i = 1 To U
Trg(i, 0) = Ref(i, 4) * Pid
Trg(i, 3) = Ref(i, 3) * Pid
Trg(i, 1) = Cos(Trg(i, 3))
Trg(i, 2) = Sin(Trg(i, 3))
Next
For i = 1 To V
k = 0
m = 0
L = Pos(i, 2) * Pid
N = Pos(i, 1) * Pid
C = Cos(N)
S = Sin(N)
For j = 1 To U
If Abs(N - Trg(j, 3)) < Ra And Abs(L - Trg(j, 0)) < Ro Then
D = C * Trg(j, 1) * Cos(L - Trg(j, 0)) + S * Trg(j, 2)
If Abs(D) = 1 Then D = -Sgn(D) * P2 Else D = Atn(-D / Sqr(1 - D * D))
If D < m Then m = D: k = j
End If
Next
If k Then
Equ(i, 0) = Ref(k, 2)
Equ(i, 1) = Ref(k, 1)
Equ(i, 2) = Round(6371 * (m + P2), 1)
End If
Next
Range(Cells(2, 9), Cells(Cells(Rows.Count, 5).End(xlUp).Row, 11)).Value = Equ
End Sub
If Abs(D) = 1 Then D = (Sgn(D) - 1) * P Else D = Atn(-D / Sqr(1 - D * D))
If Abs(D) = 1 Then D = -Sgn(D) * P2 Else D = Atn(-D / Sqr(1 - D * D))
Sub proche()
Const P# = 3.14159265358978, P2# = 1.5707963267949, Pid# = 1.74532925199433E-02, Ra# = 0.015707963267949, Ro# = 1.11072073453959E-02
Dim U&, V&, i&, j&, k&, L#, m#, D#, C#, S#, Ref(), Pos(), Trg#(), Equ(), N#
Ref = Range(Cells(2, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 7)).Value
Pos = Range(Cells(2, 7), Cells(Cells(Rows.Count, 5).End(xlUp).Row, 8)).Value
U = UBound(Ref)
V = UBound(Pos)
ReDim Trg(1 To U, 3)
ReDim Equ(1 To V, 2)
For i = 1 To U
Trg(i, 0) = Ref(i, 4) * Pid
Trg(i, 3) = Ref(i, 3) * Pid
Trg(i, 1) = Cos(Trg(i, 3))
Trg(i, 2) = Sin(Trg(i, 3))
Next
For i = 1 To V
k = 0
m = -1
L = Pos(i, 2) * Pid
N = Pos(i, 1) * Pid
C = Cos(N)
S = Sin(N)
For j = 1 To U
If Abs(N - Trg(j, 3)) < Ra And Abs(L - Trg(j, 0)) < Ro Then
D = C * Trg(j, 1) * Cos(L - Trg(j, 0)) + S * Trg(j, 2)
If D >= m Then m = D: k = j
End If
Next
If k Then
If Abs(m) = 1 Then m = Sgn(m) * P2 Else m = Atn(-m / Sqr(1 - m * m))
Equ(i, 0) = Ref(k, 2)
Equ(i, 1) = Ref(k, 1)
Equ(i, 2) = Round(6371 * (m + P2), 1)
End If
Next
Range(Cells(2, 9), Cells(Cells(Rows.Count, 5).End(xlUp).Row, 11)).Value = Equ
End Sub