Créer un distancier en Km

Bonjour YoniK

YoniK a écrit :

Je suis en train de constituer un programme de gestion de tournée ou j'ai eu besoin d'un distancier

Ici un lien pour créer une formule qui calcule la distance entre 2 points via google maps :https://analystcave.com/excel-calculate-distances-between-addresses/

=SERVICEWEB("https://maps.googleapis.com/maps/api/distancematrix/xml?origins="&A3&"&destinations="&B3&"&mode=driving&key="&mykey)

est plus simple d'emploi, avec ensuite des =FILTRE.XML(______;________)

YoniK a écrit :

j'ai également un algorithme qui calcule le chemin le plus optimiser en passant par toutes les villes que tu voudras lui intégrer ^^

Ok !

Pour le code, on m'a beaucoup aidé sur ce forum, notamment pour ce passage, c'est donc normal de partager.

Le code est prévu pour un distancier qui commence en A1. Ville départ A2, ville d'arrivé : dernière ville du distancier.

Les annotation permettent de le modifier pour pouvoir le moduler. Après je peux pas t'en dire plus, tu dois t'y connaître mieux que moi.

Le code :

Dim distancier, sol, md, k
Sub aargh()
    dl = Range("A1").End(xlDown).Row
    distancier = Range("A1").Resize(dl, dl)
    'Set Position = Cells(dl + 2, 1)
    Set Position = Range("A18")
    Position.Resize(100, 2).Clear
    md = 1000000000#
    sol = ""
    k = 0
    vd = Range("A2")
    'vd = InputBox("ville de départ (nom de ville ou laisser vide)")
    If vd <> "" Then
        For i = 2 To UBound(distancier)
            If vd = distancier(i, 1) Then vd = Chr(63 + i): Exit For
        Next i
        If i > UBound(distancier) Then MsgBox ("ville de départ non trouvée"): Exit Sub
    End If
    va = Cells(dl, 1)
    'va = InputBox("ville de d'arrivée (nom de ville,départ ou laisser vide)")
    If va <> "" And va <> "départ" Then
        For i = 2 To UBound(distancier)
            If va = distancier(i, 1) Then va = Chr(63 + i): Exit For
        Next i
        If i > UBound(distancier) Then MsgBox ("ville d'arrivée non trouvée"): Exit Sub
    End If
    If va = "départ" Then va = "-"
    visite vd, 1 + Len(vd), va
    With Position
        For i = 1 To Len(sol)
            .Cells(i, 1) = distancier(Asc(Mid(sol, i, 1)) - 63, 1)
            If i > 1 Then
                .Cells(i, 2) = distancier(Asc(Mid(sol, i - 1, 1)) - 63, Asc(Mid(sol, i, 1)) - 63)
            End If
        Next i
        .Cells(i, 2) = md
    End With
End Sub
Sub visite(Optional s = "", Optional n = 1, Optional va = "", Optional dist = 0)
    os = s
    od = dist
    For i = LBound(distancier) To UBound(distancier) - 1
        If InStr(s & va, Chr(i + 64)) = 0 Then
            If s <> "" Then
                li = Asc(Mid(s, n - 1, 1)) - 64
                d = distancier(li + 1, i + 1)
            End If
            s = s & Chr(i + 64)
            dist = dist + d
            If dist < md Then
                If n = UBound(distancier) - 2 + IIf(va = "", 1, 0) Then
                    If va = "-" Then dist = dist + distancier(li + 1, Asc(Left(s, 1)) - 63) Else If va <> "" Then dist = dist + distancier(Asc(Right(s, 1)) - 63, Asc(va) - 63)
                    If dist < md Then md = dist: sol = s & IIf(va = "-", Left(s, 1), IIf(va <> "", va, ""))
                Else
                    visite s, n + 1, va, dist
                End If
                s = os
                dist = od
            Else
                s = os
                dist = od
                Exit For
            End If
        End If
    Next i
End Sub