XL 2016 Affichage villes proches à partir coordonnées GPS

[bobland974]

Bonjour à tous,

Voilà, cela va bientôt faire deux jours que je tourne le problème dans tous les sens et je n'arrive pas à trouver la solution, je me permets donc de venir vers vous afin de solliciter votre aide.

Je dispose d'un fichier excel avec en
- colonne (A) : nom de la ville
- colonne (F) : coordonnée GPS latitude
- colonne (G) : coordonnée GPS longitude
- colonne H, I, J : nom des 3 villes les plus proches que je désire faire ressortir du tableau
> cf. fichier ville_plus_proche.xls

Je suis parti du fichier de base pour essayer d'en découdre avecu ne formule mais rien n'y fait
(copie de ville_proche.xlsx)

Par quel moyen puis-je réussir à y arriver sans créé autrement autant de colonne (distance) qu'il y a de ligne afin de pouvoir faire ressortir une liste de choix des villes les plus proches. A terme le fichier devrait contenir plusieurs milliers de colonnes.

Y a t il pas une solution plus simple à mettre en oeuvre car vu la quantité de ville dont j'ai à ma disposition cela est compliqué ?

Merci par avance pour votre aide,

 

[Dranreb]

Bonjour.
Êtes vous toujours d'accord, surtout pour limiter les distances à 40 km, et aussi avec les constantes et calculs réalisés par ce code :

Option Explicit
Const DMax = 40, LatRef = 45, LonRef = 5
'

Sub VillesProches()
…
SERA RÉEXAMINÉ SELON VOTRE RÉPONSE
…
End Sub
'

Function CodeQuad(ByVal Lat As Double, ByVal Lon As Double) As String
CodeQuad = Int(XQuad(Lat, Lon) + 0.5) & "|" & Int(YQuad(Lat) + 0.5)
End Function
Function XQuad(ByVal Lat As Double, ByVal Lon As Double) As Double
XQuad = Rad(Lon - LonRef) * 6371 * Cos(Rad(Lat)) / DMax
End Function
Function YQuad(ByVal Lat As Double) As Double
YQuad = Rad(Lat - LatRef) * 6371 / DMax
End Function
Function Dist(ByVal Lat1 As Double, ByVal Lon1 As Double, ByVal Lat2 As Double, ByVal Lon2 As Double) As Double
Lat1 = Rad(Lat1): Lon1 = Rad(Lon1): Lat2 = Rad(Lat2): Lon2 = Rad(Lon2)
Dist = ACos(Sin(Lat1) * Sin(Lat2) + Cos(Lat1) * Cos(Lat2) * Cos(Lon1 - Lon2)) * 6371
End Function

Et éviter de répondre "je ne sais pas, j'ai du mal à comprendre ce code", sinon je vais piquer un coup de sang !
J'exige au contraire que vous justifiiez votre réponse intelligemment. Faudrait quand même voir à bosser aussi un peu de votre coté, nom d'une pipe ! Ne serait-ce que pour éviter d'envisager des âneries monumentales comme la dernière fois.

Avec ça, il devrait être possible de ramener, pour déterminer les villes les plus proches de celles d'un certain carré de 40 km de coté, uniquement les villes des 8 carrés adjacents à ses cotés et sommets, en plus de celles du carré lui même.

 

[qtn.leclerc]

Bonjour.
Êtes vous toujours d'accord, surtout pour limiter les distances à 40 km, et aussi avec les constantes et calculs réalisés par ce code :

Option Explicit
Const DMax = 40, LatRef = 45, LonRef = 5
'

Sub VillesProches()
…
SERA RÉEXAMINÉ SELON VOTRE RÉPONSE
…
End Sub
'

Function CodeQuad(ByVal Lat As Double, ByVal Lon As Double) As String
CodeQuad = Int(XQuad(Lat, Lon) + 0.5) & "|" & Int(YQuad(Lat) + 0.5)
End Function
Function XQuad(ByVal Lat As Double, ByVal Lon As Double) As Double
XQuad = Rad(Lon - LonRef) * 6371 * Cos(Rad(Lat)) / DMax
End Function
Function YQuad(ByVal Lat As Double) As Double
YQuad = Rad(Lat - LatRef) * 6371 / DMax
End Function
Function Dist(ByVal Lat1 As Double, ByVal Lon1 As Double, ByVal Lat2 As Double, ByVal Lon2 As Double) As Double
Lat1 = Rad(Lat1): Lon1 = Rad(Lon1): Lat2 = Rad(Lat2): Lon2 = Rad(Lon2)
Dist = ACos(Sin(Lat1) * Sin(Lat2) + Cos(Lat1) * Cos(Lat2) * Cos(Lon1 - Lon2)) * 6371
End Function

Et éviter de répondre "je ne sais pas, j'ai du mal à comprendre ce code", sinon je vais piquer un coup de sang !
J'exige au contraire que vous justifiiez votre réponse intelligemment. Faudrait quand même voir à bosser aussi un peu de votre coté, nom d'une pipe ! Ne serait-ce que pour éviter d'envisager des âneries monumentales comme la dernière fois.

Avec ça, il devrait être possible de ramener, pour déterminer les villes les plus proches de celles d'un certain carré de 40 km de coté, uniquement les villes des 8 carrés adjacents à ses cotés et sommets, en plus de celles du carré lui même.

Bonjour,
Avec un carré de 40 km cela me parait intéressant en effet, est-ce que cela rapporte vraiment quelque chose par rapport au fichier précédemment employé ?

Désolé, je n'avais pas reçu de notification par rapport à votre message.

Bonne réception,

 

[Dranreb]

Bonjour.
Oui, puisque ça permettrait de trouver les distances jusqu'à 40km entre les 36400 communes dans un temps raisonnable. Ma question est: est-ce que le calcul du code du carré (Function CodeQuad) est acceptable à défaut d'être juste ou vaut-il mieux en étudier un meilleur ? J'ai déjà vue une correction souhaitable: il vaudrait mieux prendre:
Const DMax = 40, LatRef = 47.875, LonRef = 1.625
Ça correspondrait mieux à la moyenne des latitudes entre Calais et Perpignan, et des longitudes entre Brest et Strasbourg.
Mais il faudrait procéder un peu différemment de ce que je prévoyais: pour chaque carré, toutes les distances entre ses propres villes, puis entre ses villes et celles du carré à sa droite, du carré en dessous, puis celui en diagonal haut droit, puis bas droit, par exemple. Ou peut être avec un maillage hexagonal qui permettrait de n'avoir que 3 voisins à examiner (6 en réalité, mais les 3 autres sont ceux qui ont l'hexagone considéré parmi leurs 3 voisins)
(Et bras d'honneur en passant à certains non XLDnautes (j'espère): ces imbéciles de 'platistes' qui ne comprennent certainement dans leurs rangs aucun marin !)

 

[Dranreb]

Bonjour.
Je déduis de votre silence que mon calcul de coordonnées orthonormées pour identifier un ensemble de villes contenue dans un carré de 40 km de coté ne vous paraît pas satisfaisant, mais que vous ne savez quoi me proposer d'autre.
Alors je vous propose une projection stéréographique centrée sur un point de latitude 46,875 et longitude 1,625
Dites moi ce que vous en pensez. Il n'est pas interdit non plus de vérifier mes calculs dans la programmation.

 

[qtn.leclerc]

Bonjour,
Je viens de voir votre e-mail.
Vous pensez que la longitude 46,875 est préférable que celle précédente 47,875 ?
Excusez ma méconnaissance mais je ne connaissais pas ce type de projection (stéréographique), d'après-vous laquelle serait le plus fiable ?
J'ai vérifié certaines données à la main (n'ayant pas les connaissances suffisantes pour décrypter votre code) et cela me parait plutôt cohérent.

Bonne réception

 

[Dranreb]

Oui, 47,875 devait être une erreur de ma part puisque la latitude à mi-chemin entre Calais et Perpignan est 46,82464 d'après mes sources, donc 46,875 est plus proche.
J'ai attaqué la réécriture de la procédure VillesProches sur cette base.
À +

 

[Dranreb]

Procédure VillesProches réécrite !

 

[Dranreb]

Bonjour.
Je joins une nouvelle version avec quelques dispositifs de sécurité et des affichages d'avancements, qu'on devrait avoir le temps d'observer quand le nombre de villes approchera les 5000 environ.

Edit: Message avec statistiques affiché en fin d'exécution.

 

[qtn.leclerc]

Bonjour.
Je joins une nouvelle version avec quelques dispositifs de sécurité et des affichages d'avancements, qu'on devrait avoir le temps d'observer quand le nombre de villes approchera les 5000 environ.

Edit: Message avec statistiques affiché en fin d'exécution.

Bonjour,

Je fais le test ce jour et je reviens vers vous

Merci pour votre aide

 

[Dranreb]

Bonjour.
Vous êtes bien long à revenir vers moi, et je n'aime pas ça.
De mon coté j'ai ajouté une correction en enterrant le plan de projection stéréographique à 3000m pour compenser les erreurs de distances loin de l'origine retenue (mais la Corse doit probablement encore être assez distendue dans toutes les directions) et ajouté un graphique dans l'étude du système de quadrillage :

J'ai ajouté une feuille Statistiques pour une sorte d'historique des traitements :

Je suis assez stupéfait par la presque centaine de communes en moyenne pour 1600 km² !
J'ai donc fait l'essai sur 36466 communes trouvées sur internet. Le traitement est assez long, plusieurs minutes, mais demeure, je pense, bien inférieur à ce qu'il aurait été en examinant inutilement toutes les 664.866.345 distances possibles entre toutes les localités.

 

[qtn.leclerc]

Bonjour,

Oui désolé, j'étais en déplacement tout une partie de la semaine. J'ai effectué mes tests et de mon côté cela me parait hyper précis, de tous les tests que j'ai fait sur des villes donc je maitrise les villes voisines. Cela me parait hyper cohérent. C'est du très bon boulot et ca correspond parfaitement à ma demande.

Qu'est ce que cela donnera de plus en affinant encore plus cette projection ?
Est-ce qu'il y a un risque d'avoir d'autres villes apparaitre ?

Bonne réception,

 

[Dranreb]

Non, je ne crois pas vraiment en fait. C'est très improbable même en Corse peut être, parce que les détails loin du centre de projection sont grossis, de sorte que les carrés couvrent des surfaces plus petites en réalité. Mais la plupart des distances proches de la limite des 40 km ne sont pas reproduites dans le résultat de toute façon, et chez moi les deux Corse on partout des voisines plus proches dans la 7ième colonne.
J'ai vérifié par curiosité à Bonifacio les distance locales ne sont exagérées que de 4/1000 (avec ma correction mineure quand même)
En revanche à Pamandzi (Mayotte) tout est grossi de 51% !
Faut dire aussi que c'est à 8000 km !

 

[job75]

Bonsoir le fil, le forum,

Il me semble inutile de se casser la tête.

Depuis le 01/01/2016 il y a officiellement en France 35 585 communes.

Ce qui donne 633 128 320 distances à étudier.

Sur le fichier joint cette macro exécute les calculs en 13 min 5 s chez moi, c'est tout à fait jouable :

Sub Calcul()
Dim dur#, RT#, dmax&, t, ub&, resu$(), f$, i&, sinLat#, cosLat#, j&, da#, n&
dur = Timer
RT = 6378.137 'rayon terrestre en km
dmax = Int(Val(Feuil1.[P1])) 'distance maximum retenue en km, cellule à adapter éventuellement
t = Feuil1.[A2:C35586] 'plage à adapter éventuellement
ub = UBound(t)
ReDim resu(1 To ub, 1 To 1)
f = String(Len(CStr(dmax)), "0") & ".0 k\m " 'format des distances
For i = 1 To ub - 1
  sinLat = Sin(t(i, 2)): cosLat = Cos(t(i, 2))
  For j = i + 1 To ub
    da = sinLat * Sin(t(j, 2)) + cosLat * Cos(t(j, 2)) * Cos(t(i, 3) - t(j, 3)) 'cosinus de la distance angulaire
    da = Atn(Sqr(1 - da ^ 2) / da) 'distance angulaire en radian
    If da * RT < dmax Then resu(i, 1) = resu(i, 1) & Format(da * RT, f) & t(j, 1) & "#": n = n + 1
Next j, i
Call RAZ
Feuil2.[B2].Resize(ub) = resu 'restitution
Feuil2.Activate
dur = (Timer - dur) / 86400
MsgBox "Nombre de distances retenues " & Format(n, "#,##0") & vbLf & "Durée du calcul " & Minute(dur) & " min " & Second(dur) & " s"
End Sub

Et le classement des résultats se fait en 40 secondes :

Sub Classer()
Dim dur#, i&
dur = Timer
Application.ScreenUpdating = False
With Feuil2.[B2:B35586] 'plage à adapter éventuellement
  .TextToColumns .Cells(1), xlDelimited, Other:=True, OtherChar:="#" 'commande Convertir
  For i = 1 To .Count
    .Cells(i).Resize(, Columns.Count - 1).Sort .Cells(i), xlAscending, Orientation:=xlLeftToRight 'tri horizontal de chaque ligne
  Next i
  .Parent.Columns.AutoFit 'ajustement largeur
End With
Application.ScreenUpdating = True
dur = (Timer - dur) / 86400
MsgBox "Durée du classement " & Minute(dur) & " min " & Second(dur) & " s"
End Sub

A+

 

[Dranreb]

Bonsoir Job75.
Oui ça ne fait jamais que presque un quart d'heure après tout, même si personnellement je trouve ça trop long.
Au lieu du rayon terrestre nominal généralement utilisé pour ce genre de calcul, pourquoi appliques-tu le rayon à l'équateur ?

 

[job75]

Re Bernard,

Je viens de corriger une grossière erreur (inversion des arguments !) sur la fonction String...

Quant au rayon de la Terre je l'ai pris, ainsi que les formules trigonométriques, sur cette page web :

http://geodesie.ign.fr/contenu/fichiers/Distance_longitude_latitude.pdf

La Terre étant pratiquement sphérique les différences de rayon on peu d'importance.

A+