Reprise d'une boucle au point de sortie

Le 03/05/2015 à 10:56

Bonjour à tous!

Alors voilà, je dois rentrer une liste de mots dans une colonne A d'un tableur, et demander à l'utilisateur pour chacun de ces mots s'ils sont courants, s'ils le sont ils sont copiés dans une colonne D. Un curseur jaune parcours chaque mot et un MgBox s'affiche demandant à l'utilisateur s'ils sont courants (un forumeur Excel-pratique m'avait aidé ici d'ailleurs).

Mon problème est que lorsque j'interromps la boucle ("annuler" du MsgBox), puis décide de la faire repartir à nouveau, celle-ci repart du début à i=1, alors qu'il faudrait qu'elle reprenne à partir du mot où je me suis arrêté/ai annulé. Idem pour la colonne D (on repart de j=1 aussi), mais le problème est différent car en relançant la boucle, les mots préalablement copiés avant l'arrêt sont remplacés alors que la liste de mots courants devrait simplement s'allonger.

J'ai modifié ma macro en conséquence, mais rien y fait... Je fais donc appel à votre expertise et conseils d'optimisation pour ma macro!

Voici ma macro:

Private Sub identifier_Click()
Dim I As Integer, J As Integer, Reponse As Integer
Dim OldRange As Range

    I = 1: J = 1

Do While (Cells(I, 1) <> "//")
        Cells(I, 1).Interior.ColorIndex = 6
             Reponse = MsgBox("Est-ce un mot courant ?", vbYesNoCancel, "Mot courant")
                    If Reponse = vbYes And Cells(I, 1) <> Cells(J, 4) Then
                            Cells(J, 4) = Cells(I, 1)
                            Set OldRange = Cells(I, 1)
                                OldRange.Interior.ColorIndex = xlColorIndexNone
                                    Cells(I + 1, 1).Interior.ColorIndex = 6
                                        Cells(J, 4).Interior.ColorIndex = 24
                                            J = J + 1
                                    ElseIf Reponse = vbNo And Cells(I, 1) <> Cells(J, 4) Then
                             Cells(I + 1, 1).Interior.ColorIndex = 6
                    Set OldRange = Cells(I, 1)
            OldRange.Interior.ColorIndex = xlColorIndexNone
    ElseIf Reponse = vbCancel And Cells(I, 1) <> Cells(J, 4) Then
    Exit Do
    End If

    I = I + 1
    Loop
End Sub

Merci d'avance pour votre aide

Le 03/05/2015 à 11:21

Bonjour,

Essaie comme cela

Private Sub identifier_Click()
Dim Cel As Range
Dim I As Integer, J As Integer, Reponse As Integer
Dim OldRange As Range
    I = 1
    For Each Cel In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
        If Cel.Interior.ColorIndex = 6 Then
            I = Cel.Row
            Exit For
        End If
    Next Cel
    If Range("D" & Rows.Count).End(xlUp).Value <> "" Then
        J = Range("D" & Rows.Count).End(xlUp).Row + 1
    Else
        J = 1
    End If
    Do While (Cells(I, 1) <> "//")
        Cells(I, 1).Interior.ColorIndex = 6
        Reponse = MsgBox("Est-ce un mot courant ?", vbYesNoCancel, "Mot courant")
        If Reponse = vbYes And Cells(I, 1) <> Cells(J, 4) Then
            Cells(J, 4) = Cells(I, 1)
            Set OldRange = Cells(I, 1)
            OldRange.Interior.ColorIndex = xlColorIndexNone
            Cells(I + 1, 1).Interior.ColorIndex = 6
            Cells(J, 4).Interior.ColorIndex = 24
            J = J + 1
        ElseIf Reponse = vbNo And Cells(I, 1) <> Cells(J, 4) Then
            Cells(I + 1, 1).Interior.ColorIndex = 6
            Set OldRange = Cells(I, 1)
            OldRange.Interior.ColorIndex = xlColorIndexNone
        ElseIf Reponse = vbCancel And Cells(I, 1) <> Cells(J, 4) Then
            Exit Do
        End If
        I = I + 1
    Loop
End Sub

A+

Le 03/05/2015 à 11:25

Bonjour,

Un truc dans le genre ? Avec 2 variables (I2 et J2) niveau Module :

Dim I2 As Integer
Dim J2 As Integer

Private Sub identifier_Click()

    Dim I As Integer
    Dim J As Integer
    Dim Reponse As Integer
    Dim OldRange As Range

    If I2 <> 0 Then

        I = I2
        J = J2

    Else

        I = 1
        J = 1

    End If

    Do While (Cells(I, 1) <> "//")

        Cells(I, 1).Interior.ColorIndex = 6

        Reponse = MsgBox("Est-ce un mot courant ?", vbYesNoCancel, "Mot courant")

        If Reponse = vbYes And Cells(I, 1) <> Cells(J, 4) Then

            Cells(J, 4) = Cells(I, 1)
            Set OldRange = Cells(I, 1)
            OldRange.Interior.ColorIndex = xlColorIndexNone
            Cells(I + 1, 1).Interior.ColorIndex = 6
            Cells(J, 4).Interior.ColorIndex = 24
            J = J + 1

        ElseIf Reponse = vbNo And Cells(I, 1) <> Cells(J, 4) Then

            Cells(I + 1, 1).Interior.ColorIndex = 6
            Set OldRange = Cells(I, 1)
            OldRange.Interior.ColorIndex = xlColorIndexNone

        ElseIf Reponse = vbCancel And Cells(I, 1) <> Cells(J, 4) Then

            I2 = I
            J2 = J

            Exit Sub

        End If

        I = I + 1

    Loop

    I2 = 0
    J2 = 0

End Sub

Hervé.

Le 03/05/2015 à 11:53

Bonjour le fil, bonjour le forum,

Une autre proposition :

Public I As Integer

Private Sub identifier_Click()
Dim Reponse As Integer
Dim DEST As Range
Dim SEL As Range

Do While Cells(I + 1, 1) <> "//"
    Set SEL = Cells(I + 1, 1)
    SEL.Interior.ColorIndex = 6
    Reponse = MsgBox(Cells(I + 1, 1).Value & " est-il un mot courant ?", vbYesNoCancel, "Mot courant")
    If Reponse = vbYes Then
        Set DEST = IIf(Range("D1").Value = "", Range("D1"), Cells(Application.Rows.Count, 4).End(xlUp).Offset(1, 0))
        If SEL.Value <> DEST.Value Then
            DEST.Value = SEL.Value
            SEL.Interior.ColorIndex = xlColorIndexNone
            SEL.Offset(1, 0).Interior.ColorIndex = 6
            DEST.Interior.ColorIndex = 24
        End If
    ElseIf Reponse = vbNo Then
        Set DEST = IIf(Range("D1") = "", Range("D1"), Cells(Application.Rows.Count, 4).End(xlUp).Offset(1, 0))
        If SEL.Value <> DEST.Value Then
            SEL.Interior.ColorIndex = xlColorIndexNone
            SEL.Offset(1, 0).Interior.ColorIndex = 6
        End If
    ElseIf Reponse = vbCancel Then
        Exit Do
    End If
    I = I + 1
Loop
End Sub
Le 03/05/2015 à 12:03
4motcourant.xlsm (48.72 Ko)

Merci beaucoup Hervé pour ta réponse, mais malheureusement, j'ai essayé ton code et ça ne marche pas... Je ne comprends pas, pourtant ton code est parfaitement logique.

Je joints mon fichier (la macro se trouve dans le UserForm bouton "Identifier les mots courants"), pour pouvoir faire des tests directement sur mon fichier.

S'il y a des avis/conseils concernant mon code ou celui d'Hervé ou d'autres suggestions, n'hésitez pas! Merci

Le 03/05/2015 à 12:21
ThauThème a écrit :

Bonjour le fil, bonjour le forum,

Une autre proposition :

Public I As Integer

Private Sub identifier_Click()
Dim Reponse As Integer
Dim DEST As Range
Dim SEL As Range

Do While Cells(I + 1, 1) <> "//"
    Set SEL = Cells(I + 1, 1)
    SEL.Interior.ColorIndex = 6
    Reponse = MsgBox(Cells(I + 1, 1).Value & " est-il un mot courant ?", vbYesNoCancel, "Mot courant")
    If Reponse = vbYes Then
        Set DEST = IIf(Range("D1").Value = "", Range("D1"), Cells(Application.Rows.Count, 4).End(xlUp).Offset(1, 0))
        If SEL.Value <> DEST.Value Then
            DEST.Value = SEL.Value
            SEL.Interior.ColorIndex = xlColorIndexNone
            SEL.Offset(1, 0).Interior.ColorIndex = 6
            DEST.Interior.ColorIndex = 24
        End If
    ElseIf Reponse = vbNo Then
        Set DEST = IIf(Range("D1") = "", Range("D1"), Cells(Application.Rows.Count, 4).End(xlUp).Offset(1, 0))
        If SEL.Value <> DEST.Value Then
            SEL.Interior.ColorIndex = xlColorIndexNone
            SEL.Offset(1, 0).Interior.ColorIndex = 6
        End If
    ElseIf Reponse = vbCancel Then
        Exit Do
    End If
    I = I + 1
Loop
End Sub

Merci TauThème c'est super! Malheureusement il y a encore un tout petit "ic". Bon déjà si j'arrête la boucle, et que je reprends, la colonne J continue à s'allonger donc ça c'est géniale et c'est mon principal problème de régler. Le seul truc, c'est la colonne A: je reviens systématiquement au départ à i=1 (bon au pire je peux repartir du départ et appuyer sur "non" jusqu'à atteindre le mot où je m'étais arrêté mais c'est un peu fastidieux). Si tu as un petit code pour régler ce petit détails ce serait parfait.

Puis j'ai vu que dans le Msgbox maintenant tu avais ajouté le mot auquel la question fait référence (je n'arrivais pas à le faire) c'est super cool de ta part donc vraiment grand Merci!

frangy a écrit :

Bonjour,

Essaie comme cela

Private Sub identifier_Click()
Dim Cel As Range
Dim I As Integer, J As Integer, Reponse As Integer
Dim OldRange As Range
    I = 1
    For Each Cel In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
        If Cel.Interior.ColorIndex = 6 Then
            I = Cel.Row
            Exit For
        End If
    Next Cel
    If Range("D" & Rows.Count).End(xlUp).Value <> "" Then
        J = Range("D" & Rows.Count).End(xlUp).Row + 1
    Else
        J = 1
    End If
    Do While (Cells(I, 1) <> "//")
        Cells(I, 1).Interior.ColorIndex = 6
        Reponse = MsgBox("Est-ce un mot courant ?", vbYesNoCancel, "Mot courant")
        If Reponse = vbYes And Cells(I, 1) <> Cells(J, 4) Then
            Cells(J, 4) = Cells(I, 1)
            Set OldRange = Cells(I, 1)
            OldRange.Interior.ColorIndex = xlColorIndexNone
            Cells(I + 1, 1).Interior.ColorIndex = 6
            Cells(J, 4).Interior.ColorIndex = 24
            J = J + 1
        ElseIf Reponse = vbNo And Cells(I, 1) <> Cells(J, 4) Then
            Cells(I + 1, 1).Interior.ColorIndex = 6
            Set OldRange = Cells(I, 1)
            OldRange.Interior.ColorIndex = xlColorIndexNone
        ElseIf Reponse = vbCancel And Cells(I, 1) <> Cells(J, 4) Then
            Exit Do
        End If
        I = I + 1
    Loop
End Sub

A+

Vraiment désolé Frangy, je n'avais même pas vu ta réponse est... mal m'en a pris parce que elle marche parfaitement! Merci beaucoup FRANGY, TauThème & Hervé, je vais mixer vos contributions pour optimiser ma macro au mieux!

Très bonne journée à tous!

Le 03/05/2015 à 13:44

Bonjour le fil, bonjour le forum,

Mill_s a écrit :

Le seul truc, c'est la colonne A: je reviens systématiquement au départ à i=1

Chez moi ça marche très bien, comme tu le demandes !... N'aurais-tu pas oublié la déclaration publique de la variable I en haut du module avant la macro elle-même ?

Public I As Integer

Teste le fichier en pièce jointe.

7mill-s-v01.xlsm (17.64 Ko)
Le 03/05/2015 à 14:34
ThauThème a écrit :

Bonjour le fil, bonjour le forum,

Mill_s a écrit :

Le seul truc, c'est la colonne A: je reviens systématiquement au départ à i=1

Chez moi ça marche très bien, comme tu le demandes !... N'aurais-tu pas oublié la déclaration publique de la variable I en haut du module avant la macro elle-même ?

Public I As Integer

Teste le fichier en pièce jointe.

Oui tu as absolument raison, c'était bien mon erreur, j'avais placer le I publique après le sub et non avant.

En tout cas, ça marche merci TauThème pour cette suggestion et tes apports!

PS: J'ai fait la même erreur pour la macro d'Hervé, et du coup elle marche très bien également!

Rechercher des sujets similaires à "reprise boucle point sortie"