XL 2016 If et else comment sortir de la boucle

migau

XLDnaute Nouveau
bonjour et meilleurs voeux à tous

dans un Inputbox, je dois mettre le nom du responsable de la rando
mais si je fais une faute de frappe ou que le nom n'existe pas , je ne peux pas sortir de mon if

je sais qu'il faut mettre else mais je n'arrive pas à créer le code, et je voudrais revenir au début avec un Goto
j'y suis depuis ce matin , je ne trouve pas la bonne formule

merci pour le coup de main


VB:
Option Explicit

Sub rando()

'code en vba excel


' coloriser les cellules en fonction du km
' inférieur 10,
' inférieur à 11 
' supérieur à 11 km
'
' Variables

Dim derniere_ligne As Long
Dim ligne_en_cours As Long
Dim nbr_km As Variant


' identifer la dernière ligne du tableau
derniere_ligne = Cells(Rows.Count, 1).End(xlUp).Row


' boucler sur les lignes du tableau de la derniere ligne de la feuille (pas du tableau)
' à la première non vide ( attention : en partant du bas de la feuille)

For ligne_en_cours = 5 To derniere_ligne

' identifer le nomre de km

nbr_km = Cells(ligne_en_cours, 4).Value

' coloriser en fonction des données

    If nbr_km <= 9 Then
        nbr_km = Cells(ligne_en_cours, 4).Value
        Cells(ligne_en_cours, 4).Interior.ColorIndex = 4

         ElseIf nbr_km <= 10 Then
            nbr_km = Cells(ligne_en_cours, 4).Value
             Cells(ligne_en_cours, 4).Interior.ColorIndex = 6

            Else
                nbr_km = Cells(ligne_en_cours, 4).Value
                Cells(ligne_en_cours, 4).Interior.ColorIndex = 8
           End If
    Next

 
' sélectionner la cellule A1 en fin de script
   Range("A1").Select
'End Sub
'
'Sub responsable()

Dim der_ligne As Long
Dim ligne_active As Long
Dim meneur As String

der_ligne = Cells(Rows.Count, 1).End(xlUp).Row

    meneur = InputBox(" choisir le responsable de la marche ")

   ' MsgBox (" le responsable est : " & meneur)

        For ligne_active = 5 To der_ligne

            If meneur = Cells(ligne_active, 5).Value Then
                Cells(ligne_active, 2).Interior.ColorIndex = 14
                Cells(ligne_active, 5).Interior.ColorIndex = 16
                
                Else
         End If
    Next
End Sub
 

Pièces jointes

  • Rando.xlsm
    21 KB · Affichages: 3

M12

XLDnaute Accro
Bonjour
Fais comme ceci
VB:
    For ligne_active = 5 To der_ligne
        If meneur = Cells(ligne_active, 5).Value Then
            Cells(ligne_active, 2).Interior.ColorIndex = 14
            Cells(ligne_active, 5).Interior.ColorIndex = 16              
        Else
            if ligne_active = der_ligne then
               MsgBox "pas trouvé"
               Exit Sub
            end if
        End If
    Next
 
Dernière édition:

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Migau, M12,
La solution n'est pas dans le Else, il vaut mieux vérifier avant de rentrer dans la boucle que le nom existe dans la liste avec :
VB:
    Trouvé = 0          ' Trouvé vaudra 1 si le nom entré existe dans la liste
    While Trouvé = 0    ' Tant que le nom n'existe pas on boucle.
        meneur = InputBox("choisir le responsable de la marche ")
        If Not IsError(Application.Match(meneur, Range("E5:E1000"), 0)) Then Trouvé = 1
    Wend
 

Pièces jointes

  • Rando.xlsm
    20.4 KB · Affichages: 1

sylvanu

XLDnaute Barbatruc
Supporter XLD
Ma solution ne résout pas le problème du double.
Il faut dans ce cas tenir compte de la couleur de la cellule pour évincé les noms déjà pris.
Il faut aussi avertir si le nom entré est toujours de couleur grise, ce qui ferait que le nom existe mais n'est pas disponible.
( Essayez avec Jacques dans cette PJ )
Code:
    Trouvé = 0          ' Trouvé vaudra 1 si le nom entré existe dans la liste
    While Trouvé = 0    ' Tant que le nom n'existe pas on boucle.
        meneur = InputBox("choisir le responsable de la marche ")
        If Not IsError(Application.Match(meneur, Range("E5:E1000"), 0)) Then Trouvé = 1
    Wend
    Trouvé = 0          ' Trouvé vaudra 1 si le nom entré est disponible dans la liste
        For ligne_active = 5 To der_ligne
            If meneur = Cells(ligne_active, 5) And Cells(ligne_active, 5).Interior.Color = vbWhite Then
                Cells(ligne_active, 2).Interior.ColorIndex = 14
                Cells(ligne_active, 5).Interior.ColorIndex = 16
                Trouvé = 1
            End If
        Next
    If Trouvé = 0 Then MsgBox meneur & " n'est pas disponible."
End Sub
 

Pièces jointes

  • Rando.xlsm
    20.8 KB · Affichages: 1
Haut Bas