XL 2021 Souci avec une macro lors d'un changement de "statut"

fanou06

XLDnaute Occasionnel
Bonjour,

Sur la feuille RDV il y a une macro qui permet selon un "état" de paiement (colonne F), une colorisation de la ligne entière.
Lorsque la macro est exécutée initialement c'est ok.
Mais si je change le statut de cet "état" et que j'exécute à nouveau la macro, la colorisation reste la même.

VB:
Sub EtatCommandes()
    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range

    ' Nom de la feuille de calcul
    Set ws = ThisWorkbook.Worksheets("RDV")

    ' Définit la plage de recherche du texte "ANNULE" ou "GRATUIT"
    Set rng = ws.Range("F:F")

    ' Parcourt chaque cellule de la colonne F
    For Each cell In rng
        ' Vérifie si la cellule contient le texte "ANNULE" (en ignorant la casse)
        If StrComp(cell.Value, "ANNULE", vbTextCompare) = 0 Then
            ' Si "ANNULE" est trouvé, colore toute la ligne de A à I en gris
            ws.Range("A" & cell.Row & ":I" & cell.Row).Interior.Color = RGB(211, 211, 211)
        ElseIf StrComp(cell.Value, "GRATUIT", vbTextCompare) = 0 Then
            ' Si "GRATUIT" est trouvé, colore toute la ligne de A à I en jaune
            ws.Range("A" & cell.Row & ":I" & cell.Row).Interior.Color = RGB(255, 255, 0)
            ElseIf StrComp(cell.Value, "NON PAYE", vbTextCompare) = 0 Then
            ' Si "NON PAYE" est trouvé, colore toute la ligne de A à I en rouge
            ws.Range("A" & cell.Row & ":I" & cell.Row).Interior.Color = RGB(255, 0, 0)
        End If
    Next cell
End Sub

Une piste d'amélioration ?

Merci.
 

Pièces jointes

  • Tableau_Soledad_V4.xlsm
    91.4 KB · Affichages: 3
Solution
Bonjour @fanou06 :),

Tout d'abord, quelques réflexions :
  • Votre tableau structuré RdV s'étend de la ligne 2 jusqu'à la dernière ligne de la feuille :eek:. C'est un non-sens. Dans un tableau structuré, on évite les lignes vides.
  • Une boucle ne se fait jamais sur une colonne complète alors même que presque toutes les lignes sont vides 😟.

Je propose trois méthodes :

1 - Sur la feuille "RDV", la macro suivante :
VB:
Sub EtatCommandes()
Dim x
   For Each x In ThisWorkbook.Worksheets("RDV").Range("a1").ListObject.ListRows
      Select Case x.Range(1, 6)
         Case "ANNULE": x.Range.Interior.Color = RGB(211, 211, 211)
         Case "GRATUIT": x.Range.Interior.Color = RGB(255, 255, 0)
         Case "NON PAYE"...

Phil69970

XLDnaute Barbatruc
Bonjour @fanou06

Tu as oublié la condition "Payé"

1690480333067.png


1690480374850.png


Ta macro parcourt 1 million de lignes alors que tu te sers de moins de 500 lignes 🙃
Faire un tableau structuré avec 1 million de lignes n'est pas une bonne idée puisque justement un TS est fait pour s'agrandir avec les formules qu'il contient.
Une MFC pourrait peut être le faire donc sans code VBA et avec la mise à jour automatique
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour @fanou06 :),

Tout d'abord, quelques réflexions :
  • Votre tableau structuré RdV s'étend de la ligne 2 jusqu'à la dernière ligne de la feuille :eek:. C'est un non-sens. Dans un tableau structuré, on évite les lignes vides.
  • Une boucle ne se fait jamais sur une colonne complète alors même que presque toutes les lignes sont vides 😟.

Je propose trois méthodes :

1 - Sur la feuille "RDV", la macro suivante :
VB:
Sub EtatCommandes()
Dim x
   For Each x In ThisWorkbook.Worksheets("RDV").Range("a1").ListObject.ListRows
      Select Case x.Range(1, 6)
         Case "ANNULE": x.Range.Interior.Color = RGB(211, 211, 211)
         Case "GRATUIT": x.Range.Interior.Color = RGB(255, 255, 0)
         Case "NON PAYE": x.Range.Interior.Color = RGB(255, 0, 0)
         Case Else: x.Range.Interior.ColorIndex = xlColorIndexNone
      End Select
   Next x
End Sub

2 - Sur la feuille "RDV (1)", c'est automatique. On colore le tableau dès qu'une valeur dans la 6ème colonne est modifiée. Le code est dans le module associé à la feuille "RDV (1)" :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
   Dim x
   If Intersect(Target, ThisWorkbook.Worksheets("RDV (1)").Range("a1").ListObject.ListColumns(6).Range) Is Nothing Then Exit Sub
   Application.ScreenUpdating = False
   For Each x In ThisWorkbook.Worksheets("RDV (1)").Range("a1").ListObject.ListRows
      Select Case x.Range(1, 6)
         Case "ANNULE": x.Range.Interior.Color = RGB(211, 211, 211)
         Case "GRATUIT": x.Range.Interior.Color = RGB(255, 255, 0)
         Case "NON PAYE": x.Range.Interior.Color = RGB(255, 0, 0)
         Case Else: x.Range.Interior.ColorIndex = xlColorIndexNone
      End Select
   Next x
End Sub

3 - Sur la feuille "RDV (2)" pas de macro. C'est une MFC qui colore chaque ligne du tableau (ma préférée pour le cas en question).
 

Pièces jointes

  • fanou06- Colorer TS- v1.xlsm
    154.3 KB · Affichages: 3

Discussions similaires

Réponses
0
Affichages
220
Réponses
8
Affichages
722

Statistiques des forums

Discussions
313 224
Messages
2 096 338
Membres
106 572
dernier inscrit
JM04082023!