Option Explicit
Sub Construction_Réseaux()
Dim i%, j%, t(), d As Object, d1 As Object, f As Worksheet, a, c, b
'On enregistre la page de travail.
Set f = Sheets("feuil1")
'On enregistre le tableau de travail.
t = f.Range("A5:F9").Value
'On crée le dictionnaire.
Set d = CreateObject("Scripting.Dictionary")
Set d1 = CreateObject("Scripting.Dictionary")
'On tri le tableau en ordre croissant.
'Plus simple pour établir les tronçons.
For i = LBound(t) To UBound(t)
If t(i, 2) > t(i, 3) Then a = t(i, 2): t(i, 2) = t(i, 3): t(i, 3) = a
If t(i, 2) = Application.Min(t) Then t(i, 4) = "Début": j = i
d(t(i, 2)) = t(i, 1)
d1(t(i, 3)) = t(i, 1)
Next i
'On commence à enregistrer les tronçons.
For i = LBound(t) To UBound(t)
If Not d.exists(t(i, 3)) Then
t(i, 5) = ""
If t(i, 6) = "" Then
t(i, 6) = d1(t(i, 2)) & "-" & t(i, 1)
Else: t(i, 6) = t(i, 6) & "-" & d1(t(i, 2))
End If
Else
t(i, 5) = "Faux"
If d1.exists(t(i, 2)) Then d1(t(i, 3)) = d1(t(i, 2)) & "-" & d1(t(i, 3))
End If
Next i
'On affiche le tableau.
[I5].Resize(UBound(t), UBound(t, 2)).Value = t
End Sub