RechercheV sur longitude et latitude

berga77 · 31 Mars 2012

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

ROGER2327 · 2 Avril 2012

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 :

Décompresser Distances_2.zip
Ouvrir Distances_(vide).xlsm
Sélectionner A1
Extraire les données de Distances_2.txt (Menu Données / À partir du texte... )
Exécuter la procédure "PI_alea" (Crée aléatoirement 20000 Points d'intérêt)
Exécuter la procédure "proche"
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

berga77 · 2 Avril 2012

Re : RechercheV sur longitude et latitude

Bonsoir,

Je teste vos solutions et vous informe dès que j'ai terminé.
Encore merci.

Bernard

berga77 · 2 Avril 2012

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 · 3 Avril 2012

Re : RechercheV sur longitude et latitude

Re...

berga77 à dit:
(...)

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 · 3 Avril 2012

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.

ROGER2327 · 3 Avril 2012

Re : RechercheV sur longitude et latitude

Re...

mapomme à dit:
(...)
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 · 3 Avril 2012

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 · 4 Avril 2012

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

ROGER2327 · 4 Avril 2012

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

berga77 · 4 Avril 2012

Re : RechercheV sur longitude et latitude

Bonsoir ROGER2327,

L'exécution du code prend 1mn20 chez moi,vraiment remarquable !

Berga77

ROGER2327 · 5 Avril 2012

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

ROGER2327 · 7 Avril 2012

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

RechercheV sur longitude et latitude

berga77

XLDnaute Nouveau

Pièces jointes

ROGER2327

XLDnaute Barbatruc

Pièces jointes

berga77

XLDnaute Nouveau

berga77

XLDnaute Nouveau

ROGER2327

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

ROGER2327

XLDnaute Barbatruc

berga77

XLDnaute Nouveau

mapomme

XLDnaute Barbatruc

ROGER2327

XLDnaute Barbatruc

berga77

XLDnaute Nouveau

ROGER2327

XLDnaute Barbatruc

ROGER2327

XLDnaute Barbatruc

Discussions similaires

RechercheV sur longitude et latitude

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency