RechercheV sur longitude et latitude

berga77

XLDnaute Nouveau
Bonsoir à tous,

Je dispose d'un tableau contenant les données suivantes:
Les 4 premières colonnes contiennent 36000 villes géolocalisées avec département.
Villes:département:Latitude:Longitude.

Les 4 colonnes suivantes contiennent 20000 Points d'Intérêt (PI) géolocalisés mais sans le département.
Nom:Code:Latitude:Longitude:

Je souhaiterai ajouter une nouvelle colonne (Dpt) pour situer chaque PI dans son département.

J'ai réussi avec RechercheV (sans préciser la valeur proche) pour la latitude OU la longitude,
mais je ne sais pas faire pour Long ET Lat.
D'autres approches ou solutions sont les bienvenues.

Ce fichier est utilisé dans Oziexplorer (logiciel de cartographie pour la
randonnée)pour afficher le PI sur la carte.

Je joins un extrait du fichier pour faciliter la résolution de ma demande.

Par avance, merci.

Bernard
 

Pièces jointes

  • BaseGéo.xls
    24.5 KB · Affichages: 268

ROGER2327

XLDnaute Barbatruc
Re : RechercheV sur longitude et latitude

Suite...


Voici mon matériel d'essai. En raison de la lourdeur des données, le classeur d'essai ne peut être enregistré "prêt à l'emploi".
J'ai donc créé un fichier de données (format texte, séparateur de champ "tabulation"). Le classeur vide et le fichier de données sont dans l'archive .zip ci-jointe.

Mode d'emploi :

  1. Décompresser Distances_2.zip
  2. Ouvrir Distances_(vide).xlsm
  3. Sélectionner A1
  4. Extraire les données de Distances_2.txt (Menu Données / À partir du texte... )
  5. Exécuter la procédure "PI_alea" (Crée aléatoirement 20000 Points d'intérêt)
  6. Exécuter la procédure "proche"
  7. Attendre (~3 minutes 50 chez moi)


ROGER2327
#5731


Mercredi 11 Clinamen 139 (Saint Maquereau, Intercesseur - fête Suprême Quarte)
13 Germinal An CCXX, 6,5653h - morille
2012-W14-1T15:45:24Z
 

Pièces jointes

  • Distances_2.zip
    554.2 KB · Affichages: 95
Dernière édition:

berga77

XLDnaute Nouveau
Re : RechercheV sur longitude et latitude

Bonsoir,

A Modeste geedee,
J'ai intégré votre code dans celui de mapomme et de ROGER2327 ce qui me permet
de vérifier rapidement l'exactitude des coordonnées et de "visiter"le lieu.


A ROGER2327,
Votre code fonctionne parfaitement,4 mn pour obtenir le résultat
sur le fichier réel.

A mapomme
Votre code fonctionne également parfaitement ,mais je dois approfondir
les possibilités offertes par les filtres.

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.

Je convertirai le fichier obtenu dans son format d'origine (.names)qui est un
fichier .dbf et le mettrai à disposition.

Merci infiniment pour le temps et le savoir donné.

Bernard
 

ROGER2327

XLDnaute Barbatruc
Re : RechercheV sur longitude et latitude

Re...


(...)

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.

(...)
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...​


ROGER2327
#5734


Mercredi 11 Clinamen 139 (Saint Maquereau, Intercesseur - fête Suprême Quarte)
13 Germinal An CCXX, 9,4981h - morille
2012-W14-1T22:47:44Z
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : RechercheV sur longitude et latitude

Bonjour berga77 Roger et le forum,

Ne cherchez plus ! J'avais 'merdoyé' avec ma formule de calcul des distances. J'ai corrigé et je tombe maintenant pile poil sur les mêmes distances que celles calculées par Roger (j'en ai profité pour corriger une autre erreur dans ma fonction de calcul de distance mais qui ne se voyait pas dans le cas présent). Merci Roger!

Je joins le nouveau fichier et efface l'autre lien.

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)

Le fichier est ici.
 
Dernière édition:

ROGER2327

XLDnaute Barbatruc
Re : RechercheV sur longitude et latitude

Re...


(...)
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)
(...)
j'ai effectivement cherché l'optimisation.
La lenteur vient de la grande faiblesse d'Excel dans le domaine du calcul des fonctions trigonométriques et trigonométriques inverses. On a besoin d'une fonction Acos... ...qui n'existe pas en VBA ! On pourrait être tenté d'utiliser WorksheetFunction.Acos mais cette fonction est d'une lenteur phénoménale. Force est de se rabattre sur l'identité Acos(x)=Atn(-x/Sqr(1-x^2))+pi/2.
La fonction Atn de VBA et moins lente que WorksheetFunction.Acos, mais n'est pas pour autant d'une rapidité exemplaire. Je ne vois pas comment s'en passer. Si quelqu'un a une idée...​


ROGER2327
#5737


Jeudi 12 Clinamen 139 (Saint Georges Dazet, poulpe au regard de soie - fête Suprême Quarte)
14 Germinal An CCXX, 3,4616h - hêtre
2012-W14-2T08:18:28Z
 

berga77

XLDnaute Nouveau
Re : RechercheV sur longitude et latitude

Bonsoir à tous,

Comme indiqué plus haut, je mets à disposition des intéressés un zip comprenant un fichier .map
et un .names qui servent à la recherche toponymique d' Oziexplorer. Ce fichier peut comporter
des erreurs. Il est modifiable en renommant le .names en .dbf et en l'ouvrant avec Open Office.
Les versions récentes d'excel ne gèrent plus les .dbf

http://cjoint.com/?0DdwdlhClG1

Merci encore à ceux qui m'ont apporté leur aide.

Berga77
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Re : RechercheV sur longitude et latitude

Bonsoir à tous

J'ai essayé une autre voie à partir du fichier de Roger. En prenant comme hypothèse que les PI sont sur le territoire français (puisqu'on en recherche approximativement le département) limiter le nombre de recherche parmi les 36000 communes. Pour cela, ne calculer la distance au point PI que des communes situées dans un carré de 200km dont le PI est au centre. En convertissant approximativement les km en degrés décimaux par (100km/40000*360) on trouve 0,9 seconde. Le formule utilisée pour limiter la recherche s'écrit | lat(ville)-lat(PI) | < 0,9 et | long(ville)-long(PI) | < 0,9.

Pour s'assurer (à peu près) que les communes sont presque toutes en France, j'ai modifié la sub PI_alea(). Un PI est le point milieu (en latitude et longitude) de deux villes choisies au hasard. Les résultats montrent quelques PI sans département d'appartenance. En regardant de plus près (via Google Map) j'ai constaté que ce sont des PI situés hors de France. Ce sont souvent des points milieu de communes issues de l'Est, Alsace ou Lorraine, et d'une ville de Corse.
Ex: Gueberschwihr et Sisco qui donne un point milieu à 65 km à l'est de Milan (qui par conséquent n"appartient pas à un département français).

Les résultats sur mon bouzin donnent:
Programme initial de Roger : moyenne de 6 mn 18s
Programme de Roger modifié : moyenne de 4 mn 16s (gain # 30%)

NB: merci à Roger qui m'a signalé une erreur dans mon calcul de distance si le PI a les mêmes coordonnées qu'une commune. je vais corriger le fichier concerné.

Le code modifié de Roger que j'ai utilisé:
Code:
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
 
Dernière édition:

ROGER2327

XLDnaute Barbatruc
Re : RechercheV sur longitude et latitude

Re...


Excellente idée, d'autant qu'avec les données réelles de berga77 (merci à lui d'avoir communiqué le résultat du travail, on ne voit malheureusement pas cela tous les jours...), les plus grandes distances n'atteignent pas 60 km.

Et on va accélérer grave, comme dit mon petit-fils :​
VB:
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

Voyez ce que ça donne en vitesse. Ça en dit long sur les performances des fonctions trigonométriques de VBA...​


ROGER2327
#5745


Vendredi 13 Clinamen 139 (Nativité de Maldoror, corsaire aux cheveux d’or - fête Suprême Quarte)
15 Germinal An CCXX, 0,7233h - abeille
2012-W14-3T01:44:09Z
 
Dernière édition:

ROGER2327

XLDnaute Barbatruc
Re : RechercheV sur longitude et latitude

Bonsoir à tous


mapomme m'a signalé une erreur dans mon dernier code.
Effectivement, la ligne​
Code:
                If Abs(D) = 1 Then D = (Sgn(D) - 1) * P Else D = Atn(-D / Sqr(1 - D * D))
est fautive. Il faut écrire​
Code:
                If Abs(D) = 1 Then D = -Sgn(D) * P2 Else D = Atn(-D / Sqr(1 - D * D))


Merci à lui pour le travail de vérification qu'il effectue. Je corrige cette erreur dans le code du message #24.​


ROGER2327
#5747


Vendredi 13 Clinamen 139 (Nativité de Maldoror, corsaire aux cheveux d’or - fête Suprême Quarte)
15 Germinal An CCXX, 9,9672h - abeille
2012-W14-3T23:55:16Z
 
Dernière édition:

ROGER2327

XLDnaute Barbatruc
Re : RechercheV sur longitude et latitude

Suite...


On devrait gratter encore 12 à 13 % avec cette variante :​
VB:
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



ROGER2327
#5756


Lundi 16 Clinamen 139 (Exit Saint Domenico Theotocopouli, el Greco - fête Suprême Quarte)
18 Germinal An CCXX, 0,9659h - ciguë
2012-W14-6T02:19:05Z
 
Dernière édition:

Statistiques des forums

Discussions
315 098
Messages
2 116 190
Membres
112 679
dernier inscrit
Yupanki