XL 2016 Affichage villes proches à partir coordonnées GPS

bobland974

XLDnaute Nouveau
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,
 

Pièces jointes

  • Ville_plus_proche.xlsx
    17.2 KB · Affichages: 73
  • Copie de Ville_Proche.xlsx
    11.4 KB · Affichages: 51

job75

XLDnaute Barbatruc
Bon voyez ce fichier (2) et le code de l'UserForm :
VB:
Dim tablo 'mémorise la variable

Private Sub ComboBox1_Change() 'Ville
Dim RT$, daMax, i As Variant, Lat, Lon, sinLat, cosLat, j&, da, a(), n&, resu()
RT = 6378.137 'rayon terrestre en km
daMax = Val(ComboBox2) / RT 'distance angulaire max
i = Application.Match(ComboBox1, Columns(1), 0)
If IsNumeric(i) And UBound(tablo) > 2 Then
    Lat = tablo(i, 3): Lon = tablo(i, 4): sinLat = Sin(Lat): cosLat = Cos(Lat)
    For j = 2 To UBound(tablo)
        If j <> i Then
            da = sinLat * Sin(tablo(j, 3)) + cosLat * Cos(tablo(j, 3)) * Cos(Lon - tablo(j, 4)) 'cosinus de la distance angulaire
            da = Atn(Sqr(Abs(1 - da ^ 2)) / da) 'distance angulaire en radian
            If da <= daMax Then
                ReDim Preserve a(1, n) 'base 0
                a(0, n) = tablo(j, 1)
                a(1, n) = RT * da
                n = n + 1
            End If
        End If
    Next j
End If
If n Then
    tri a, 0, n - 1
    ReDim resu(n - 1, 1)
    For j = 0 To n - 1
        resu(j, 0) = a(0, j)
        resu(j, 1) = Format(a(1, j), "0.0 k\m")
    Next j
    ListBox1.List = resu
    ListBox1.ListIndex = -1
Else
    ListBox1.Clear
End If
End Sub

Private Sub ComboBox2_Change() 'Dmax
ComboBox1_Change
End Sub

Private Sub UserForm_Initialize()
With [A1].CurrentRegion.Resize(, 4)
    tablo = .Value
    If .Rows.Count > 1 Then ComboBox1.List = .Offset(1).Resize(.Rows.Count - 1).Value
End With
ComboBox2.List = Array("10 km", "20 km", "30 km", "40 km", "50 km", "100 km", "150 km")
End Sub

Sub tri(a, gauc, droi)  ' Quick sort
Dim ref, g, d, temp
ref = a(1, (gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While a(1, g) < ref: g = g + 1: Loop
    Do While ref < a(1, d): d = d - 1: Loop
    If g <= d Then
      temp = a(1, g): a(1, g) = a(1, d): a(1, d) = temp
      temp = a(0, g): a(0, g) = a(0, d): a(0, d) = temp
      g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
End Sub
Bonne nuit.
 

Pièces jointes

  • Distances entre communes(2).xlsm
    37.9 KB · Affichages: 9
Dernière édition:

erics83

XLDnaute Impliqué
Bon voyez ce fichier (2) et le code de l'UserForm :
VB:
Dim tablo 'mémorise la variable

Private Sub ComboBox1_Change() 'Ville
Dim RT$, daMax, i As Variant, Lat, Lon, sinLat, cosLat, j&, da, a(), n&, resu()
RT = 6378.137 'rayon terrestre en km
daMax = Val(ComboBox2) / RT 'distance angulaire max
i = Application.Match(ComboBox1, Columns(1), 0)
If IsNumeric(i) And UBound(tablo) > 2 Then
    Lat = tablo(i, 3): Lon = tablo(i, 4): sinLat = Sin(Lat): cosLat = Cos(Lat)
    For j = 2 To UBound(tablo)
        If j <> i Then
            da = sinLat * Sin(tablo(j, 3)) + cosLat * Cos(tablo(j, 3)) * Cos(Lon - tablo(j, 4)) 'cosinus de la distance angulaire
            da = Atn(Sqr(Abs(1 - da ^ 2)) / da) 'distance angulaire en radian
            If da <= daMax Then
                ReDim Preserve a(1, n) 'base 0
                a(0, n) = tablo(j, 1)
                a(1, n) = RT * da
                n = n + 1
            End If
        End If
    Next j
End If
If n Then
    tri a, 0, n - 1
    ReDim resu(n - 1, 1)
    For j = 0 To n - 1
        resu(j, 0) = a(0, j)
        resu(j, 1) = Format(a(1, j), "0.0 k\m")
    Next j
    ListBox1.List = resu
    ListBox1.ListIndex = -1
Else
    ListBox1.Clear
End If
End Sub

Private Sub ComboBox2_Change() 'Dmax
ComboBox1_Change
End Sub

Private Sub UserForm_Initialize()
With [A1].CurrentRegion.Resize(, 4)
    tablo = .Value
    If .Rows.Count > 1 Then ComboBox1.List = .Offset(1).Resize(.Rows.Count - 1).Value
End With
ComboBox2.List = Array("10 km", "20 km", "30 km", "40 km", "50 km", "100 km", "150 km")
End Sub

Sub tri(a, gauc, droi)  ' Quick sort
Dim ref, g, d, temp
ref = a(1, (gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While a(1, g) < ref: g = g + 1: Loop
    Do While ref < a(1, d): d = d - 1: Loop
    If g <= d Then
      temp = a(1, g): a(1, g) = a(1, d): a(1, d) = temp
      temp = a(0, g): a(0, g) = a(0, d): a(0, d) = temp
      g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
End Sub
Bonne nuit.
SUPER !!! Merci Job75, c'est exactement ce que je cherchais à avoir !!!
MERCI !!!

et je vois que je n'aurai pas pu faire le USF (enfin, rapatrier les données....), et d'ailleurs, pour ma compréhension, pourquoi mettre ?
VB:
ListBox1.ListIndex = -1
, je l'ai enlevé pour voir, et le résultat (=l'affichage de resu) est le même....si vous l'avez mis, c'est qu'il y a une bonne raison.

Merci pour vos éclairages,

Merci pour votre aide,
Eric
 

Katido

XLDnaute Occasionnel
Bonjour,

A titre indicatif, le calcul pour 35 000 communes dure chez moi un peu plus d'une minute, avec la vraie formule de trigo sphérique en Arccos(...)
A condition de ne mémoriser que les 3 plus proches et de ne calculer Arccos qu'à la fin des 612 000 000 comparaisons

A noter qu'une formule en Sqr(x² + y²) donne des résultats relativement proches et n'est guère plus rapide (avec x = longitude * Cos(latitude) et y = latitude)
 

Pièces jointes

  • ModuleCommunesVoisines.txt
    2.2 KB · Affichages: 8

Discussions similaires

Statistiques des forums

Discussions
311 713
Messages
2 081 806
Membres
101 819
dernier inscrit
lukumubarth