Surbrillance de cellule modifier

Le 18/10/2020 à 17:34

Bonjour à tous,

Je fais encore appel à vous, les pro du VBA :)

J'ai le code VBA suivant, si il y a une modification dans les cellules 1 à 8 j'ajoute la valeur "Modification ou Création dans la cellule 11.

Tout vas bien, mais je souhaite aller plus loin, en ajoutant une surbrillance sur la cellule qui comporte la modification.

J'ai testé plusieurs petite chose mais rien de concluant pour adapter le bout de code, avez-vous une idée ?

Merci beaucoup d'avance.

Thomas

' ###################################################################################################
' # MAJ DES DONNEES DU NOUVEL ONGLET                                                                #
' ###################################################################################################
' On va parcourir les deux onglets en parallèle. Pour chaque ligne du nouvel onglet, on va regarder
' s'il était déjà présent dans l'ancien onglet et dans ce cas on récupèrera les données déjà traitées.
' S'il n'était pas présent, c'est que l'abonné a été créé entre temps et on laissera les
' colonnes vides ; il faudra les remplir manuellement par la suite.
' On tag les abonnés qui ont changé entre les deux extractions ou qui ont été créés via un flag dans
' la colonne "A vérifier".
    ' On réinitialise les index des lignes des onglets pour repartir du début des onglets.
    IndexLigneNew = 2
    IndexLigneOld = 2
    ' On parcour le nouvel onglet ligne par ligne et on compare la ligne en cours dans le nouvel
    ' onglet avec la ligne en cours dans l'ancien onglet.
    While (Sheets(IndexOngletNew).Cells(IndexLigneNew, 1).Value <> "")
        ' On vérifie qu'on n'a pas atteint la fin de l'ancien onglet.
        If (Sheets(IndexOngletOld).Cells(IndexLigneOld, 1).Value <> "") Then
           ' On compare les deux numéros.
           If Sheets(IndexOngletNew).Cells(IndexLigneNew, 1).Value = Sheets(IndexOngletOld).Cells(IndexLigneOld, 1).Value Then
                ' Si les deux abonnés ont le même numéro on copie les infos depuis l'ancien onglet vers le nouveau.
                Sheets(IndexOngletOld).Range(Cells(IndexLigneOld, 1), Cells(IndexLigneOld, NbColonnes)).Copy Destination:=Sheets(IndexOngletNew).Range("L" & IndexLigneNew)
                ' On réinitialise la cellule "A vérifier".
                Sheets(IndexOngletNew).Cells(IndexLigneNew, 11).Value = ""
                ' On met à jour la cellule "A vérifier" si des paramètres de l'abonné ont changé depuis M-1.
                If (Sheets(IndexOngletNew).Cells(IndexLigneNew, 1).Value <> Sheets(IndexOngletOld).Cells(IndexLigneOld, 1).Value) Or _
                    (Sheets(IndexOngletNew).Cells(IndexLigneNew, 2).Value <> Sheets(IndexOngletOld).Cells(IndexLigneOld, 2).Value) Or _
                    (Sheets(IndexOngletNew).Cells(IndexLigneNew, 3).Value <> Sheets(IndexOngletOld).Cells(IndexLigneOld, 3).Value) Or _
                    (Sheets(IndexOngletNew).Cells(IndexLigneNew, 4).Value <> Sheets(IndexOngletOld).Cells(IndexLigneOld, 4).Value) Or _
                    (Sheets(IndexOngletNew).Cells(IndexLigneNew, 5).Value <> Sheets(IndexOngletOld).Cells(IndexLigneOld, 5).Value) Or _
                    (Sheets(IndexOngletNew).Cells(IndexLigneNew, 6).Value <> Sheets(IndexOngletOld).Cells(IndexLigneOld, 6).Value) Or _
                    (Sheets(IndexOngletNew).Cells(IndexLigneNew, 7).Value <> Sheets(IndexOngletOld).Cells(IndexLigneOld, 7).Value) Or _
                    (Sheets(IndexOngletNew).Cells(IndexLigneNew, 8).Value <> Sheets(IndexOngletOld).Cells(IndexLigneOld, 8).Value) Then
                    Sheets(IndexOngletNew).Cells(IndexLigneNew, 11).Value = "MODIFICATION"
                        NbAbonneAVerifier = NbAbonneAVerifier + 1
                End If
                ' On passe aux lignes suivantes dans les deux onglets.
                IndexLigneNew = IndexLigneNew + 1
                IndexLigneOld = IndexLigneOld + 1
            Else
                If Sheets(IndexOngletNew).Cells(IndexLigneNew, 1).Value < Sheets(IndexOngletOld).Cells(IndexLigneOld, 1).Value Then
                ' Si le nouvel abonné actuel est plus petit que l'ancien dans la liste c'est que le
                ' numéro a été créé entre temps.
                ' Le nouvel abonné doit être vérifié et on avance ensuite d'une ligne dans le nouvel
                ' onglet.
                    Sheets(IndexOngletNew).Cells(IndexLigneNew, 11).Value = "CREATION"
                    NbAbonnesCree = NbAbonnesCree + 1
                    IndexLigneNew = IndexLigneNew + 1
                Else
                ' Sinon, c'est que l'ancien abonné est plus petit que le nouveau et donc que le
                ' numéro a été supprimé entre temps.
                ' On avance ensuite d'une ligne dans l'ancien onglet.
                    NbAbonnesSuppr = NbAbonnesSuppr + 1
                    IndexLigneOld = IndexLigneOld + 1
                End If
           End If
        Else
            ' On est dans le cas où on a terminé de traiter tous les numéros de l'ancien onglet,
            ' les numéros restant dans le nouvel onglet sont donc forcément des nouveaux numéros
            ' devant être vérifiés.
            Sheets(IndexOngletNew).Cells(IndexLigneNew, 11).Value = "CREATION"
            NbAbonnesCree = NbAbonnesCree + 1
            IndexLigneNew = IndexLigneNew + 1
        End If
    Wend
    ' Si on a traité toutes les lignes du nouvel onglet mais qu'il reste des lignes dans l'ancien
    ' onglet, on les comptabilise comme abonnés supprimés.
    While (Sheets(IndexOngletOld).Cells(IndexLigneOld, 1).Value <> "")
        NbAbonnesSuppr = NbAbonnesSuppr + 1
        IndexLigneOld = IndexLigneOld + 1

    Wend
Le 18/10/2020 à 17:50

Bonjour Tony0203

On peut optimiser ton code pour le test des ligne et ainsi mettre en surbrillance 

  ' ###################################################################################################
  ' # MAJ DES DONNEES DU NOUVEL ONGLET                                                                #
  ' ###################################################################################################
  ' On va parcourir les deux onglets en parallèle. Pour chaque ligne du nouvel onglet, on va regarder
  ' s'il était déjà présent dans l'ancien onglet et dans ce cas on récupèrera les données déjà traitées.
  ' S'il n'était pas présent, c'est que l'abonné a été créé entre temps et on laissera les
  ' colonnes vides ; il faudra les remplir manuellement par la suite.
  ' On tag les abonnés qui ont changé entre les deux extractions ou qui ont été créés via un flag dans
  ' la colonne "A vérifier".
  Dim Col As Long
  ' On réinitialise les index des lignes des onglets pour repartir du début des onglets.
  IndexLigneNew = 2
  IndexLigneOld = 2
  ' On parcour le nouvel onglet ligne par ligne et on compare la ligne en cours dans le nouvel
  ' onglet avec la ligne en cours dans l'ancien onglet.
  While (Sheets(IndexOngletNew).Cells(IndexLigneNew, 1).Value <> "")
    ' On vérifie qu'on n'a pas atteint la fin de l'ancien onglet.
    If (Sheets(IndexOngletOld).Cells(IndexLigneOld, 1).Value <> "") Then
      ' On compare les deux numéros.
      If Sheets(IndexOngletNew).Cells(IndexLigneNew, 1).Value = Sheets(IndexOngletOld).Cells(IndexLigneOld, 1).Value Then
        ' Si les deux abonnés ont le même numéro on copie les infos depuis l'ancien onglet vers le nouveau.
        Sheets(IndexOngletOld).Range(Cells(IndexLigneOld, 1), Cells(IndexLigneOld, NbColonnes)).Copy Destination:=Sheets(IndexOngletNew).Range("L" & IndexLigneNew)
        ' On réinitialise la cellule "A vérifier".
        Sheets(IndexOngletNew).Cells(IndexLigneNew, 11).Value = ""
        ' On met à jour la cellule "A vérifier" si des paramètres de l'abonné ont changé depuis M-1.
        For Col = 1 To 8
          If (Sheets(IndexOngletNew).Cells(IndexLigneNew, Col).Value <> Sheets(IndexOngletOld).Cells(IndexLigneOld, Col).Value) Then
            Sheets(IndexOngletNew).Cells(IndexLigneNew, Col).Interior.ColorIndex = 3
            Sheets(IndexOngletNew).Cells(IndexLigneNew, 11).Value = "MODIFICATION"
            NbAbonneAVerifier = NbAbonneAVerifier + 1
          End If
        Next Col
        ' On passe aux lignes suivantes dans les deux onglets.
        IndexLigneNew = IndexLigneNew + 1
        IndexLigneOld = IndexLigneOld + 1
      Else
        If Sheets(IndexOngletNew).Cells(IndexLigneNew, 1).Value < Sheets(IndexOngletOld).Cells(IndexLigneOld, 1).Value Then
          ' Si le nouvel abonné actuel est plus petit que l'ancien dans la liste c'est que le
          ' numéro a été créé entre temps.
          ' Le nouvel abonné doit être vérifié et on avance ensuite d'une ligne dans le nouvel
          ' onglet.
          Sheets(IndexOngletNew).Cells(IndexLigneNew, 11).Value = "CREATION"
          NbAbonnesCree = NbAbonnesCree + 1
          IndexLigneNew = IndexLigneNew + 1
        Else
          ' Sinon, c'est que l'ancien abonné est plus petit que le nouveau et donc que le
          ' numéro a été supprimé entre temps.
          ' On avance ensuite d'une ligne dans l'ancien onglet.
          NbAbonnesSuppr = NbAbonnesSuppr + 1
          IndexLigneOld = IndexLigneOld + 1
        End If
      End If
    Else
      ' On est dans le cas où on a terminé de traiter tous les numéros de l'ancien onglet,
      ' les numéros restant dans le nouvel onglet sont donc forcément des nouveaux numéros
      ' devant être vérifiés.
      Sheets(IndexOngletNew).Cells(IndexLigneNew, 11).Value = "CREATION"
      NbAbonnesCree = NbAbonnesCree + 1
      IndexLigneNew = IndexLigneNew + 1
    End If
  Wend
  ' Si on a traité toutes les lignes du nouvel onglet mais qu'il reste des lignes dans l'ancien
  ' onglet, on les comptabilise comme abonnés supprimés.
  While (Sheets(IndexOngletOld).Cells(IndexLigneOld, 1).Value <> "")
    NbAbonnesSuppr = NbAbonnesSuppr + 1
    IndexLigneOld = IndexLigneOld + 1
  Wend

@+

Le 18/10/2020 à 17:57

Bonsoir, BrunoM45 bonsoir,

Avez vous votre fichier ? Juste pour voir si la méthode de Steelson peut s'y adapter.
Ensuite je suite perdu dans le choix des variables !
For Lig = 1 to 8 => et en fait Lig correspond aux colonnes ! (juste pour rire)

@ bientôt

LouReeD

Le 19/10/2020 à 18:27

Salut LouReeD

Comme je n'avais pas de fichier, j'ais fait ça à la vit'faille et même pas regardé

C'est corrigé... et c'est mieux

Le 19/10/2020 à 22:03

Bonsoir BrunoM45 et LouReeD,

Merci pour vos réponses, la proposition de BrunoM45 fonctionne et correspond au besoin, chapeau :)

Au passage j'ai rajouté un petit ".Interior.ColorIndex = xlColorIndexNone" pour réinitialise la cellule avant un nouveau lancement.

Et j'ai corrigé la variable pour être plus parlant :)

Merci à vous deux

Le 19/10/2020 à 23:04

Sans fichier c'est dur de travailler dessus, mais l'idée de Steelson est de mettre les données des feuilles en tableau VBA et de faire vos tests sur ces tableaux afin d'accélérer le fonctionnement, mais comme il y a la gestion des couleurs je crois que ce n'est pas si utile que cela.

@ bientôt

LouReeD

Rechercher des sujets similaires à "surbrillance modifier"