1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
| Sub Villes()
Dim TabVilleEtape
Dim TheCell As Range
Dim DicoDistance As New Dictionary
Dim DicoVille As New Dictionary
Dim LastRow As Integer
Dim x As Integer, y As Integer
Dim TabRetour
'On place les km dans le dico (plus rapide que d'aller chercher dans le tableau excel
With ThisWorkbook.Sheets("Données")
LastRow = .Range("B28").End(xlUp).Row
TabVilleEtape = .Range("B7", .Cells(LastRow, "B").Offset(0, LastRow - 7)).Value
End With
'On boucle dans le tableau
For x = 2 To LastRow - 6
For y = 2 To LastRow - 6
DicoDistance.Add TabVilleEtape(1, x) & "¤" & TabVilleEtape(1, y), CDbl(TabVilleEtape(x, y))
Next
Next
'On récupère la liste des villes étapes
With ThisWorkbook.Sheets("Données")
For Each TheCell In .Range("X10", .Range("X29").End(xlUp))
DicoVille.Add TheCell.Value, ""
Next
End With
'On appelle PermuteVilles
With ThisWorkbook.Sheets("Données")
TabRetour = PermuteVilles(DicoDistance, DicoVille, .Range("X8"), .Range("X9"))
'On place le meilleur parcours dans le tabelau excel
'On vide
.Range("Y8:Y28").ClearContents
'On inscrit les km
.Range("AA7").Value = Split(TabRetour, "$")(1)
'On ne conserve que le parcours
TabRetour = Split(TabRetour, "$")(0)
'On permute la chaine en tableau
TabRetour = Split(TabRetour, "¤")
'On place le tableau
.Range("Y8").Resize(UBound(TabRetour) + 1).Value = WorksheetFunction.Transpose(TabRetour)
End With
End Sub
Function PermuteVilles(DicoKm As Dictionary, DicoVille As Dictionary, VilleDepart As String, VilleArrive, Optional aParcours As String = "<vide>", Optional aDistance As Double)
Dim DicoVilleTmp As New Dictionary
Dim iVille As Long
Static MeilleurKm As Double
Static MeilleurParcours As String
Static NbrPermute As Long
Dim ParcoursEnCours As String
Dim Distance As Double
Dim ParcoursTmp As String
Dim DistanceTmp As Double
'On prolonge le parcours existant
If aParcours <> "<vide>" Then
ParcoursEnCours = aParcours
Distance = aDistance
Else
'On initialise les variables "Meilleur", les variables static sont conservées, même aprés une analyse complete
MeilleurKm = 0
MeilleurParcours = ""
'Et On début le parcours
ParcoursEnCours = VilleDepart
NbrPermute = 0
End If
'On clone le dico, moins la ville de départ
For iVille = 0 To DicoVille.Count - 1
If DicoVille.Keys(iVille) <> VilleDepart Then
DicoVilleTmp.Add DicoVille.Keys(iVille), ""
End If
Next
'On calcule les distances entre villeDepart et toutes les villes étapes
For iVille = 0 To DicoVilleTmp.Count - 1
NbrPermute = NbrPermute + 1
'On ajoute la ville au parcours et distance temporaires, pour conserver les bon contenu dans ParcoursEnCours et Distance
'Comme ça, après l'appel récursif, ParcoursEnCours et Distance contiennent les bonne valeur pour accépter le teste d'une nouvelle ville
If ParcoursEnCours <> "" Then ParcoursTmp = ParcoursEnCours & "¤"
ParcoursTmp = ParcoursTmp & DicoVilleTmp.Keys(iVille)
DistanceTmp = Distance + DicoKm(VilleDepart & "¤" & DicoVilleTmp.Keys(iVille))
'On note dans le tableau Excel (analyse)
With ThisWorkbook.Sheets("Données")
With .Cells(.Rows.Count, "B").End(xlUp).Offset(1)
.Value = ParcoursTmp
.Offset(0, 1) = DistanceTmp
End With
End With
'Si la distance dépasse la distance la plus courte déjà trouvée
If MeilleurKm = 0 Or MeilleurKm > Distance Then
PermuteVilles DicoKm, DicoVilleTmp, CStr(DicoVilleTmp.Keys(iVille)), VilleArrive, ParcoursTmp, DistanceTmp
Else
'On retourne la meilleur combinaison
PermuteVilles = MeilleurParcours & "$" & CStr(MeilleurKm) & " / " & NbrPermute
Exit Function
End If
Next
If DicoVilleTmp.Count = 0 Then
'On boucle le trajet avec la ville d'arrivé
If ParcoursEnCours <> "" Then ParcoursEnCours = ParcoursEnCours & "¤"
ParcoursEnCours = ParcoursEnCours & VilleArrive
Distance = Distance + DicoKm(VilleDepart & "¤" & VilleArrive)
'On verifie les km
If MeilleurKm = 0 Or MeilleurKm > Distance Then
MeilleurKm = Distance
MeilleurParcours = ParcoursEnCours
End If
'On vide les variables pour annalyser le prochain parcours
Distance = 0
ParcoursEnCours = ""
End If
'On retourne la meilleur combinaison
PermuteVilles = MeilleurParcours & "$" & CStr(MeilleurKm) & " / " & NbrPermute
End Function |
Optimisation itinéraires routiers avec étapes
Répondre avec citation
Partager