Retirer chaine caractere à droite suivant condition

Bonsoir,

J'ai pu suivant condition incrémenter une chaine de caractère , chaine existante + complément

maintenant suivant à une deuxième exécution si la condition est n'est plus remplie, retrouver la chaine de caractère d'origine .

merci

cordialement,

'
' couleur Macro
'
Sub couleur()
    Sheets("comparatif").Select
    finligne = 129          ' ActiveSheet.UsedRange.Rows.Count
    numligne = 14
    totaldetect = Range("M11").Value
    moy50pcent = totaldetect / 2
    moy60pcent = totaldetect * 0.6
    moy70pcent = totaldetect * 0.7
    moy80pcent = totaldetect * 0.8
    moy85pcent = totaldetect * 0.85
    moy90pcent = totaldetect * 0.9
    moy95pcent = totaldetect * 0.95

    chainenontest = "<Non testé>"

    While numligne < finligne ' boucle debut ligne et fin de ligne

        xtextemodifier = Range("B" & numligne).Value + chainenontest

        ' si total=0 alors chaine = chaine +      "<Non testé>"

        If Range("M" & numligne).Value = 0 Then
            Range("B" & numligne, "B" & numligne).Replace what:=(Range("B" & numligne, "B" & numligne)), replacement:=xtextemodifier
        Else

             ' retablir si total <> 0

            If Range("M" & numligne).Value <= moy50pcent Then ' si cellule inf ou egale a 50
               Range("B" & numligne, "B" & numligne).Interior.Color = RGB(255, 0, 0)
          End If

          If Range("M" & numligne).Value > moy50pcent And Range("M" & numligne).Value < moy70pcent Then ' si sup a 50 et inf= a 70
              Range("B" & numligne, "B" & numligne).Interior.Color = RGB(224, 160, 0)
           End If

           If Range("M" & numligne).Value >= moy70pcent And Range("M" & numligne).Value < moy80pcent Then ' si sup a 70 et inf= a 80
               Range("B" & numligne, "B" & numligne).Interior.Color = RGB(224, 255, 0)
           End If

           If Range("M" & numligne).Value >= moy80pcent And Range("M" & numligne).Value < moy85pcent Then ' si sup a 80 et inf= a 85
               Range("B" & numligne, "B" & numligne).Interior.Color = RGB(128, 224, 0)
            End If

           If Range("M" & numligne).Value >= moy85pcent And Range("M" & numligne).Value < moy90pcent Then ' si sup a 85 et inf= a 90
               Range("B" & numligne, "B" & numligne).Interior.Color = RGB(96, 255, 0)
          End If

           If Range("M" & numligne).Value >= moy95pcent And Range("M" & numligne).Value <= totaldetect Then ' si sup a 95 et inf= a 100
               Range("B" & numligne, "B" & numligne).Interior.Color = RGB(32, 255, 255)
           End If

        End If

        numligne = numligne + 1
        chainenontest = "<Non testé>"

    Wend

End Sub

 

Bonjour,

Tu peux ajouter une phase d'initialisation avant d'effectuer le traitement

Sub couleur()
    Sheets("comparatif").Select
    finligne = 129          ' ActiveSheet.UsedRange.Rows.Count
    numligne = 14
    totaldetect = Range("M11").Value
    moy50pcent = totaldetect / 2
    moy60pcent = totaldetect * 0.6
    moy70pcent = totaldetect * 0.7
    moy80pcent = totaldetect * 0.8
    moy85pcent = totaldetect * 0.85
    moy90pcent = totaldetect * 0.9
    moy95pcent = totaldetect * 0.95
    chainenontest = "<Non testé>"
    While numligne < finligne ' boucle debut ligne et fin de ligne

        ' ********* Initialisation *********
        ' on supprime "<Non testé>"
        Range("B" & numligne).Replace what:=chainenontest, replacement:=""
        ' la couleur de remplissage est supprimée
        Range("B" & numligne).Interior.Pattern = xlNone
        ' *********

        ' si total=0 alors chaine = chaine & "<Non testé>"
        If Range("M" & numligne).Value = 0 Then
            Range("B" & numligne).Value = Range("B" & numligne).Value & chainenontest
        Else
            If Range("M" & numligne).Value <= moy50pcent Then ' si cellule inf ou egale a 50
                Range("B" & numligne, "B" & numligne).Interior.Color = RGB(255, 0, 0)
            End If
            If Range("M" & numligne).Value > moy50pcent And Range("M" & numligne).Value < moy70pcent Then ' si sup a 50 et inf= a 70
                Range("B" & numligne, "B" & numligne).Interior.Color = RGB(224, 160, 0)
            End If
            If Range("M" & numligne).Value >= moy70pcent And Range("M" & numligne).Value < moy80pcent Then ' si sup a 70 et inf= a 80
                Range("B" & numligne, "B" & numligne).Interior.Color = RGB(224, 255, 0)
            End If
            If Range("M" & numligne).Value >= moy80pcent And Range("M" & numligne).Value < moy85pcent Then ' si sup a 80 et inf= a 85
                Range("B" & numligne, "B" & numligne).Interior.Color = RGB(128, 224, 0)
            End If
            If Range("M" & numligne).Value >= moy85pcent And Range("M" & numligne).Value < moy90pcent Then ' si sup a 85 et inf= a 90
                Range("B" & numligne, "B" & numligne).Interior.Color = RGB(96, 255, 0)
            End If
            If Range("M" & numligne).Value >= moy95pcent And Range("M" & numligne).Value <= totaldetect Then ' si sup a 95 et inf= a 100
                Range("B" & numligne, "B" & numligne).Interior.Color = RGB(32, 255, 255)
            End If
        End If
        numligne = numligne + 1
    Wend
End Sub

A+

bonjour,

merci ,nickel

pour compléter est-il possible de rendre une cellule non modifiable, car je protège la feuille, la macro ne fonctionne plus.

Si l'utilisateur modifie la cellule celle ci doit revenir dans sa valeur d'origine et ainsi empêche l'enregistrement de la modification.

Bonsoir,

Un exemple.

Au début du code après la la sélection de la feuille de calcul, tu insères :

ActiveSheet.Unprotect

Et à la fin d la procédure :

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

Cdlt

nb : la feuille de calcul est protégé avant l’exécution de la procédure !

Bonsoir,

super, ensuite est-qu'il me sera possible d'y revenir pour une éventuelle modification.

Cordialement,

merci Frangy et Jean-Eric