chemin le plus court entre 2 cellules si c'est possible

Question

Bonjour à tous.

Comme toujours, je suis un habitué du post au mauvais endroit, donc si c'est le cas, désolé.

Voilà mon problème :
Dans excel, je suis sur une case (C3 par exemple), et je souhaite aller en A2 (par exemple). Pour cela, je ne dois passer que sur des cases où il y a un "1" (par exemple, si dans B2 il y a un "1", je peux aller en B2 pour aller en A2, alors que si en B3, il y a un "0", je ne peux pas passer sur cette case). Ce problème peut s'étendre à plusieurs cases à "traverser" (genre de C3 vers I8), et peut prendre des trajectoire bizarre si il n'y pas d'autres solutions (genre de C3 vers A2, faire D3 D4 E5 E6 D7 C7 B7 A7 A6 A5 A4 A3 A2). La trajectoire doit être la plus courte possible, et ne doit pas dépacer un certain nombre de déplacements.

J'espère avoir été clair. En gros, je cherche à reconstituer un gars qui marche sur un damier, et qui peut pas marcher sur l'eau, et donc doit marcher sur la terre ^^.

Merci d'avance

Cordialement

cs_Orohena · Answer

Salut Le code ci-dessous cherche le chemin le plus court entre une cellule de départ (ici C2) et une cellule d'arrivée (D9), et matérialise ce chemin en mettant les cellules en caractères gras. La procédure chercheCellule() explore de manière récursive tous les chemins possibles, ne conservant que le meilleur dans le tableau meilleurChemin().

Option Explicit Dim meilleurChemin() As Range Dim cible As Range Dim depart As String, arrivee As String Sub Main() Dim l As Integer, c As Integer, chem() As Range Dim i As Integer Dim m As String depart = " C2 " arrivee = "D9" Set cible = Range(arrivee) ReDim meilleurChemin(0) Cells.ClearFormats ReDim chem(0) Set chem(0) = Range(depart) chercheCellule chem If UBound(meilleurChemin) = 0 Then MsgBox "Impossible" Else For i = 0 To UBound(meilleurChemin) meilleurChemin(i).Font.Color = RGB(255, 0, 0) Next i cible.Font.Color = RGB(255, 0, 0) End If End Sub Sub chercheCellule(chem() As Range) Dim l As Integer, c As Integer Dim p As Range Dim i As Integer, j As Integer Dim ch() As Range Set p = chem(UBound(chem)) For l = p.Row - 1 To p.Row + 1 For c = p.Column - 1 To p.Column + 1 If l > 0 And c > 0 Then If l cible.Row And c cible.Column Then If UBound(meilleurChemin) = 0 Or _ UBound(chem) < UBound(meilleurChemin) Then ReDim meilleurChemin(UBound(chem)) For i = 0 To UBound(chem) Set meilleurChemin(i) = chem(i) Next End If Else If Cells(l, c).Value = 1 Then For i = 0 To UBound(chem) If chem(i).Row l And chem(i).Column c Then Exit For Next i If i > UBound(chem) Then ReDim ch(i) For j = 0 To UBound(chem) Set ch(j) = chem(j) Next Set ch(i) = Cells(l, c) chercheCellule ch End If End If End If End If Next c Next l End Sub

Amicalement

KungFuChaos · Answer

Bonjour.

Tout d'abord, merci de ton aide. Mais chez moi, ça ne fonctionne pas (programme ne répond plus).

Peut être que c'est moi qui n'est pas assez clairement défini les données de mon problème, je ne sais pas.

Si quelqu'un m'explique comment peut on mettre des scrins (si on peut), j'en mettrai pour que cela soit plus clair.

Je sollicite en tout cas toujours de l'aide :(

Cordialement

cs_Orohena · Answer

Salut Le code que je t'ai donné cherche le chemin le plus court reliant deux cellules et composé de cellules contenant un 1... Dans ton module, peux-tu ajouter et exécuter le sub suivant, qui crée deux chemins entre les cellules C2 et D9 et lance le sub Main(). Il devrait colorier en rouge le chemin de droite (7 cellules, contre 11 pour le chemin de gauche).

Sub init() Dim l As Integer, c As Integer Dim chemin As Variant Cells.Clear For l = 1 To 30 For c = 1 To 30 Cells(l, c).Value = 0 Next c Next l chemin = Array("B1", "A1", "A2", "A3", "B4", "C4", "C5", "C6", "C7", _ "C8", "D8", "D2", "E3", "E4", "E5", "E6", "E7") For l = 0 To UBound(chemin) Range(chemin(l)).Value = 1 Next l Main End Sub

Amicalement

KungFuChaos · Answer

Effectivement, comme cela, ça fonctionne. Mais j'ai peut être trouvé pourquoi cela ne fonctionnait pas.

Je n'ai pas que 2 chemins possibles, mais pas loin d'une centaine de milliers (j'ai un cadrillage de 40x40, avec une majorité de 1), et quand j'éxécute ta macro avec plus de 2 chemins, ça me refait planter la macro.

cs_Orohena · Answer

Salut

C'est en effet l'explication. La récursion dans ton cas utilise beaucoup de mémoire.

Tout dépend maintenant de l'objectif de ce programme. Si c'est pédagogique, cet objectif est atteint ; maintenant, si c'est un programme dont tu as réellement besoin, il rame abominablement.

Amicalement

KungFuChaos · Answer

C'est un programme ni pédagogique, ni réellement besoin. J'ai commencé la réalisation d'un petit jeu sous Excel, et je n'avais pas pensé à ce problème. Je voudrais juste trouver comment résoudre ce problème, comprendre comment cela se réalise, et pouvoir continuer. Voilà.

Merci encore pour ton aide

Chemin le plus court entre 2 cellules si c'est possible

6 réponses

Votre réponse

Discussions similaires