Code qui lit les valeurs approximé de ma cellule active

Bonjour,

Je suis nouvelle dans l'univers de la programmation alors il m'arrive encore de rencontrer quelques petits problèmes. Cette fois-ci le problème arrive lorsque je j'essaie de faire jouer mon code. Il ne se passe rien.

Mise en contexte : Il y a un script VBA qui dessine en jaune le fond de certaines cases du tableur . On commence l'analyse de notre échantillon sur la case C6. La prochaine case dont le fond sera modifié en jaune sera celle tel que décrit ci-dessous:

En regardant la case immédiatement en haut, en bas, à droite et à gauche de la dernière case sélectionnée (fond jaune), se diriger vers la case ayant la plus basse valeur profilométrique SI cette valeur est plus basse que celle de la dernière case sélectionnée;

AUTREMENT, se diriger vers la case ayant une valeur équivalente à celle de la dernière case sélectionnée ET qui n'a pas encore été sélectionnée;

SINON, arrêter de modifier le fond de certaines cases en jaune. (l'analyse est alors terminée)

Voici mon code jusqu'à maintenant

Private Sub CommandButton2_Click()

nbl = ActiveSheet.Range("A1048576").End(xlUp).Row
nbc = ActiveSheet.Range("A1048576").End(xlToLeft).Column

For i = 3 To nbc
    For j = 6 To nbl

    cond1 = Cells(i, j + 1).Value < Cells(i, j).Value
    cond2 = Cells(i, j - 1).Value < Cells(i, j).Value
    cond3 = Cells(i + 1, j).Value < Cells(i, j).Value
    cond4 = Cells(i - 1, j).Value < Cells(i, j).Value

    cond5 = ActiveCell.Interior.ColorIndex <> 6

    If cond1 And cond5 Then
        ActiveCell.Interior.ColorIndex = 6

    ElseIf cond2 And cond5 Then
        ActiveCell.Interior.ColorIndex = 6

    ElseIf cond3 And cond5 Then
        ActiveCell.Interior.ColorIndex = 6

    ElseIf cond4 And cond5 Then
        ActiveCell.Interior.ColorIndex = 6
    End If

    Next j
Next i

End Sub

Excel Vba ne m'offre aucun feedback( exemple : next sans for). J'aimerais savoir si vous auriez des idées pour mieux attaquer ce problème et obtenir une réponse à la fin.

Merci

Ps: je vais aussi joindre le fichier excel qui contient le tableaur et l'apparence de la réponse de celui-ci

Bonsoir, au vu du code, vous faites bien un test des couleurs qui "entourent" la cellule active, suivant ce test vous modifiez ou pas la couleur de la cellule active, mais ensuite à aucun moment vous changez de cellule active !

se diriger vers la case ayant la plus basse valeur profilométrique SI cette valeur est plus basse que celle de la dernière case sélectionnée;

Du coup le code fait du sur place.... Il ne se passe rien à l'écran, non ?

vbMBHB

Salut Eternalamp, VbMsgBox,

une solution qui te permet, via un double-clic, de démarrer ton calcul depuis la cellule de ton choix.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Cancel = True
Cells.Interior.Color = RGB(255, 255, 255)
'
iRow = Target.Row
iCol = Target.Column
Target.Interior.Color = RGB(255, 255, 0)
'
Do While iOK = 0
    iFlag = 1000
    iIdx1 = 0
    iOK = 1
    '
    For x = 0 To 3
        iRow1 = IIf(x Mod 2 = 1, IIf(x = 1, iRow - 1, iRow + 1), iRow)
        iCol1 = IIf(x Mod 2 = 0, IIf(x = 0, iCol - 1, iCol + 1), iCol)
        If Cells(iRow1, iCol1) < Cells(iRow, iCol) And Cells(iRow1, iCol1) < iFlag Then
            iFlag = Cells(iRow1, iCol1)
            iIdx = x
        End If
        If Cells(iRow1, iCol1) = Cells(iRow, iCol) And Cells(iRow1, iCol1).Interior.Color <> RGB(255, 255, 0) Then iIdx1 = x
    Next
    iOK = IIf(iFlag < 1000 Or iIdx1 > 0, 0, 1)
    If iOK = 0 Then
        iIdx2 = IIf(iFlag < 1000, iIdx, iIdx1)
        iRow = IIf(iIdx2 Mod 2 = 1, IIf(iIdx2 = 1, iRow - 1, iRow + 1), iRow)
        iCol = IIf(iIdx2 Mod 2 = 0, IIf(iIdx2 = 0, iCol - 1, iCol + 1), iCol)
        Cells(iRow, iCol).Interior.Color = RGB(255, 255, 0)
    End If
Loop
'
End Sub

A+

Merci beaucoup pour le retour. Il est vraiment tard en ce moment alors je ne peux pas aller vérifier vos solutions pour le moment. Mais dès que l'occasion s'y présente je le fais et je vous donne un retour sur ce que j'ai compris et mes résultats.

Merci encore

Bonjour,

J'aurais une question pour ma part : lorsque 2 cellules (voire plus) répondent à la condition (non colorée, valeur la plus basse et inférieure ou égale à la dernière valeur colorée), y a-t-il un critère de choix d'une des cellules répondant également à la condition, plutôt qu'une autre ?

Cordialement.

En réponse à @MFerrand.

Si aucune de ces trois cases a une valeur plus basse ou égale à la valeur de la dernière case sélectionnée .L'analyse sera considéré comme complète.

Je m'excuse ça été un manque de précision de ma part

vbMsgBoxHelpButton a écrit :

Bonsoir, au vu du code, vous faites bien un test des couleurs qui "entourent" la cellule active, suivant ce test vous modifiez ou pas la couleur de la cellule active, mais ensuite à aucun moment vous changez de cellule active !

se diriger vers la case ayant la plus basse valeur profilométrique SI cette valeur est plus basse que celle de la dernière case sélectionnée;

Du coup le code fait du sur place.... Il ne se passe rien à l'écran, non ?

vbMBHB

Vous avez totalement raison, je n'ai jamais initialisé une case de départ et je n'ai jamais précisé une nouvelle initialisation de mouvement, donc le surplace.

Merci pour cette illumination, j'étais j'imagine trop fatigué pour voir cette erreur

Salut Eternalamp,

Salut l'équipe,

je pense que tu n'as pas saisi la question, pourtant judicieuse, de MFerrand!

Si plusieurs valeurs, autour de la cellule "active", satisfont aux conditions, quelles qu'elles soient, laquelle, de la première rencontrée à l'ultime, devra-t-elle être l'élue pour ouvrir la voie?

A+

curulis57 a écrit :

Salut Eternalamp,

Salut l'équipe,

je pense que tu n'as pas saisi la question, pourtant judicieuse, de MFerrand!

Si plusieurs valeurs, autour de la cellule "active", satisfont aux conditions, quelles qu'elles soient, laquelle, de la première rencontrée à l'ultime, devra-t-elle être l'élue pour ouvrir la voie?

A+

Je ne la repose pas, Curulis l'a fait. Mais il serait bien d'y répondre, ce cas se rencontre dans ton fichier.

Je viens de saisir la question et j'avoue ne mettre pas rendu aussi loin dans l'analyse du problème. Je me suis référé aux images joints pour les conditions dès mouvement. Il faut aussi ajouter que le code commence à la première case jaune (6,3) et qu'à partir de cela il joue et se termine un peu plus loin. L'instructeur a fourni une réponse ( un aperçu visuel de ce que devrait avoir l'air le code)

Mais si en prend on compte votre observation : si aucune case entourant ma case actuelle a une valeur plus petite au semblable( parce que la case sélectionné devrait être celle de la plus petite valeur) je devrais rajouter une ligne qui fait mention de l'arrêt du code si de tels conditions arrivent.

Je voudrais remercier tout le monde qui m'a aidé dans mon processus de réflexion pour trouver la solution à mon problème. J'ai finis par aboutir sur ce code comme oeuvre finale

couleur = ActiveSheet.Cells(6.3).Interior.Color
analyse = True
x = 6
y = 3

Do While analyse

    valeur = ActiveSheet.Cells(x, y).Value
    cond1 = Cells(x, y + 1)
    cond2 = Cells(x, y - 1)
    cond3 = Cells(x + 1, y)
    cond4 = Cells(x - 1, y)

    Min = Application.Min(cond1.Value, cond2.Value, cond3.Value, cond4.Value)

    If cond1.Value <= valeur And cond1.Value = Min And cond1.Interior.Color <> couleur Then
        y = y + 1
        ActiveSheet.Cells(x, y).Interior.Color = couleur

    ElseIf cond2.Value <= valeur And cond2.Value = Min And cond2.Interior.Color <> couleur Then
        y = y - 1
        ActiveSheet.Cells(x, y).Interior.Color = couleur

    ElseIf cond3.Value <= valeur And cond3.Value = Min And cond3.Interior.Color <> couleur Then
        x = x + 1
        ActiveSheet.Cells(x, y).Interior.Color = couleur

    ElseIf cond4.Value <= valeur And cond4.Value = Min And cond4.Interior.Color <> couleur Then
        x = x - 1
        ActiveSheet.Cells(x, y).Interior.Color = couleur
    Else
        analyse = False
    End If
Loop

Je vous remercie encore une fois

Me