VBA - Algorithme Labyrinthe - erreur 1004

[aspx]

Bonjour,

Je suis actuellement en train de coder un algorithme qui trouve un chemin pour sortir d'un labyrinthe. Le labyrinthe est dessiné sur ma feuille excel de la cellule 1x1 à la cellule 12x6 (j'ai colorié en jaune les zones inaccessibles et en blanc les zones accessibles). On part de la case 2x1 qui est blanche.

L'algorithme consiste à tester tt les cases alentour (gauche, haut, droite puis bas), et y aller si on trouve une case blanche (puis colorier la case courante en noir pour dire qu'on y est déjà passé). Si on ne trouve pas de case blanche on revient sur nos pas en trouvant une case noire. etc...

Passons sur l'algorithme car le problème vient du code VBA en lui même, j'ai une erreur 1004, apparemment assez banale vu les recherches que j'ai pu faire sur le net mais je n'arrive pas à la résoudre...

L'erreur survient sur ma première condition concernant la couleur d'une case :

If (current_col > 1) And (Cells(current_row, current_col - 1).Interior.ColorIndex = 2) Then
            Cells(current_row, current_col).Interior.ColorIndex = 1
            current_col = current_col - 1

Pour info current_col et current_row stockent la position courante (colonne et ligne resp.).

J'ai fait des tests séparés sur Cells(i,j).Interior.ColorIndex et ça marche bien, je vois pas trop où est le problème...

Voici mon code en entier si besoin il y a :

Sub Laby()
Dim compteur, current_row, current_col As Integer
Dim fini As Boolean
fini = False
compteur = 0
current_row = 2
current_col = 1
While (fini = False)
    Cells(current_row, current_col).Select
    If (compteur > 0) And ((current_row = 1) Or (current_row = 12) Or (current_col = 6) Or (current_col = 1)) Then
            fini = True
            MsgBox "Algorithme terminé"
    Else
        If (current_col > 1) And (Cells(current_row, current_col - 1).Interior.ColorIndex = 2) Then
            Cells(current_row, current_col).Interior.ColorIndex = 1
            current_col = current_col - 1
        ElseIf (current_row > 1) And (Cells(current_row - 1, current_col).Interior.ColorIndex = 2) Then
            Cells(current_row, current_col).Interior.ColorIndex = 1
            current_row = current_row - 1
        ElseIf (current_col < 6) And (Cells(current_row, current_col + 1).Interior.ColorIndex = 2) Then
            Cells(current_row, current_col).Interior.ColorIndex = 1
            current_col = current_col + 1
        ElseIf (current_row < 12) And (Cells(current_row + 1, current_col).Interior.ColorIndex = 2) Then
            Cells(current_row, current_col).Interior.ColorIndex = 1
            current_row = current_row + 1
        ElseIf (current_col > 1) And (Cells(current_row, current_col - 1).Interior.ColorIndex = 1) Then
            Cells(current_row, current_col).Interior.ColorIndex = 1
            current_col = current_col - 1
        ElseIf (current_row > 1) And (Cells(current_row - 1, current_col).Interior.ColorIndex = 1) Then
            Cells(current_row, current_col).Interior.ColorIndex = 1
            current_row = current_row - 1
        ElseIf (current_col < 6) And (Cells(current_row, current_col + 1).Interior.ColorIndex = 1) Then
            Cells(current_row, current_col).Interior.ColorIndex = 1
            current_col = current_col + 1
        ElseIf (current_row < 12) And (Cells(current_row - 1, current_col).Interior.ColorIndex = 1) Then
            Cells(current_row, current_col).Interior.ColorIndex = 1
            current_row = current_row + 1
        End If
    End If
    compteur = compteur + 1
Wend
End Sub

Merci par avance !

 

[kiki29]

Re : VBA - Algorithme Labyrinthe - erreur 1004

Salut, voir Excel Downloads - Multi Laby

 

[ROGER2327]

Re : VBA - Algorithme Labyrinthe - erreur 1004

Bonjour aspx

Erreur classique. Dans la structure If... Then... End, les deux membres de la fonction AND

(current_col > 1) And (Cells(current_row, current_col - 1).Interior.ColorIndex = 2)

sont évalués avant l'évaluation de la fonction AND.
Par conséquent, si current_col est inférieur ou égal à 1, Cells(current_row, current_col - 1) n'existe pas et engendre une erreur.

Il faut donc tester conditionnellement le deuxième membre de la fonction AND :

[COLOR="DarkSlateGray"][B]If current_col > 1 Then
   If Cells(current_row, current_col - 1).Interior.ColorIndex = 2 Then
      Cells(current_row, current_col).Interior.ColorIndex = 1
      current_col = current_col - 1
      [COLOR="SeaGreen"]'(...)[/COLOR]
   End If
End If[/B][/COLOR]

ROGER2327
#3182

 

[aspx]

Re : VBA - Algorithme Labyrinthe - erreur 1004

Bonjour aspx

Erreur classique. Dans la structure If... Then... End, les deux membres de la fonction AND

(current_col > 1) And (Cells(current_row, current_col - 1).Interior.ColorIndex = 2)

sont évalués avant l'évaluation de la fonction AND.
Par conséquent, si current_col est inférieur ou égal à 1, Cells(current_row, current_col - 1) n'existe pas et engendre une erreur.

Il faut donc tester conditionnellement le deuxième membre de la fonction AND :

[COLOR="DarkSlateGray"][B]If current_col > 1 Then
   If Cells(current_row, current_col - 1).Interior.ColorIndex = 2 Then
      Cells(current_row, current_col).Interior.ColorIndex = 1
      current_col = current_col - 1
      [COLOR="SeaGreen"]'(...)[/COLOR]
   End If
End If[/B][/COLOR]

ROGER2327
#3182

J'avais placé le test avant en pensant que ça pourrait influer mais si les deux sont forcément exécutés... Merci bcp je vais arranger ça !