Ignorer les 2 premières lignes d'une macro existante ci-jointe

Le 01/04/2021 à 17:38

Bonjour,

J'utilise très régulièrement la macro suivante (en PJ // "Macro Alterner couleur ligne"), permettant d'alterner la couleur des lignes en fonction de la colonne A, du moment où la valeur en de la cellule en colonne A est différente de la valeur de la cellule précédente en colonne A.

Exemple : si A4 = A3, alors la couleur de ligne A4 reste identique à la couleur de la ligne A3 // si A5 dif A4, alors la couleur de la ligne A4 change par rapport à la couleur de la ligne 4, et passe gris // etc etc etc...

Sub ReperRefs()
Application.ScreenUpdating = False
    Range([A2], [A65536].End(xlUp)).Select
    NbItemsSource = Selection.Rows.Count
    ReDim tabl(1 To NbItemsSource, 1 To 1)
    i = 1
    T = 1
    For Each Cell In Selection
        tabl(i, 1) = Cell.Value
        i = i + 1
    Next Cell
    X = 2
    For j = 1 To NbItemsSource
        If Cells(j + 2, 1).Value = "" Then
            Range(Cells(j + 1, 1), Cells(j + 1, 150)).Interior.ColorIndex = X
             Range("A1").Select
            End
        End If
        If tabl(j + 1, 1) = tabl(j, 1) Then
            Range(Cells(j + 1, 1), Cells(j + 1, 150)).Interior.ColorIndex = X
        Else
            Range(Cells(j + 1, 1), Cells(j + 1, 150)).Interior.ColorIndex = X
            T = T + 1
            If X = 2 Then
                X = 15
            ElseIf X = 15 Then
                X = 2
            End If
        End If
    Next j

End Sub

Sur cet macro, la première ligne est ignorée actuellement.

J'aimerai conserver exactement la même macro, mais arriver à ignorer les 2 premières lignes, pour que cette macro s'effectue à partir de la cellule A3, et donc de la 3ème ligne, pour ne pas toucher à la mise en forme de la 2nd ligne (et de la 1ère).

Voici le résultat que je souhaiterais :

resultat souhaite

En vous remerciant par avance pour votre aide

8macro-alterner-couleur-ligne.xlsm (21.34 Ko)
Le 01/04/2021 à 17:59

Bonsoir,

essayez en remplaçant ceci : Range([A2], [A65536].End(xlUp)).Select
par : Range([A3], [A65536].End(xlUp)).Select

et : Range(Cells(j + 1, 1), Cells(j + 1, 150)).Interior.ColorIndex = X
par : Range(Cells(j + 2, 1), Cells(j + 2, 150)).Interior.ColorIndex = X

J'ai bien dit "essayez"

@ bientôt

LouReeD

Le 01/04/2021 à 18:13

Bonjour tout le monde. Une autre variante à essayer :

Range([A3], [A65536].End(xlUp)).Select
NbItemsSource = Selection.Rows.Count + 1

Le 01/04/2021 à 21:50

Bonsoir Optimix,

je ne comprend pas bien le +1 ici : NbItemsSource = Selection.Rows.Count + 1Quel est le but d'avoir un nombre de ligne plus grand ?

Par contre comme la première cellule à remplir est en ligne 3, il faut un décalage de +1 = 2 par rapport à la boucle de j sur le nombre de ligne :
quand J=1 teste la première ligne de la plage, alors le résultat de couleur doit se trouver en ligne 3 d'où le J+2 au lieu du J+1, non ?

@ bientôt

LouReeD

Le 02/04/2021 à 06:57

Bonjour LooReed,
Tu as raison, j'aurais dû mettre le code complet. Paresse quand tu nous tiens !
La raison du + 1 est simple : sans cela on est en dépassement de capacité. Tu peux essayer.

Sub ReperRefs()
Application.ScreenUpdating = False
    Range([A3], [A65536].End(xlUp)).Select
    NbItemsSource = Selection.Rows.Count + 1
    ReDim tabl(1 To NbItemsSource, 1 To 1)
    i = 1
    T = 1
    For Each Cell In Selection
        tabl(i, 1) = Cell.Value
        i = i + 1
    Next Cell
    X = 2
    For j = 1 To NbItemsSource
        If Cells(j + 2, 1).Value = "" Then
            Range(Cells(j + 1, 1), Cells(j + 1, 150)).Interior.ColorIndex = X
            If Cells(NbItemsSource + 1, 1) = Cells(NbItemsSource, 1) Then Range(Cells(NbItemsSource + 1, 1), Cells(NbItemsSource + 1, 150)).Interior.Color = Cells(NbItemsSource, 1).Interior.Color
            Range("A1").Select
            End
        End If
        If tabl(j + 1, 1) = tabl(j, 1) Then
            Range(Cells(j + 2, 1), Cells(j + 2, 150)).Interior.ColorIndex = X
        Else
            Range(Cells(j + 2, 1), Cells(j + 2, 150)).Interior.ColorIndex = X
            T = T + 1
            If X = 2 Then
                X = 15
            ElseIf X = 15 Then
                X = 2
            End If
        End If
    Next j
End Sub
Le 02/04/2021 à 09:31

Bonjour Optimix et LouReeD,

Je vous remercie pour vos retours, le code complet d'Optimix est bien OK c'est parfait

Un grand merci encore !

Le 15/04/2021 à 12:19

Re Bonjour,

Après utilisation du code suivant d'Optimix, je viens de remarquer une erreur sur la mise en forme de la dernière ligne en utilisant la macro :

Sub ReperRefs()
Application.ScreenUpdating = False
    Range([A3], [A65536].End(xlUp)).Select
    NbItemsSource = Selection.Rows.Count + 1
    ReDim tabl(1 To NbItemsSource, 1 To 1)
    i = 1
    T = 1
    For Each Cell In Selection
        tabl(i, 1) = Cell.Value
        i = i + 1
    Next Cell
    X = 2
    For j = 1 To NbItemsSource
        If Cells(j + 2, 1).Value = "" Then
            Range(Cells(j + 1, 1), Cells(j + 1, 150)).Interior.ColorIndex = X
            If Cells(NbItemsSource + 1, 1) = Cells(NbItemsSource, 1) Then Range(Cells(NbItemsSource + 1, 1), Cells(NbItemsSource + 1, 150)).Interior.Color = Cells(NbItemsSource, 1).Interior.Color
            Range("A1").Select
            End
        End If
        If tabl(j + 1, 1) = tabl(j, 1) Then
            Range(Cells(j + 2, 1), Cells(j + 2, 150)).Interior.ColorIndex = X
        Else
            Range(Cells(j + 2, 1), Cells(j + 2, 150)).Interior.ColorIndex = X
            T = T + 1
            If X = 2 Then
                X = 15
            ElseIf X = 15 Then
                X = 2
            End If
        End If
    Next j
End Sub

En effet, lorsque l'avant dernière et la dernière ligne sont différentes, les couleurs devraient s'alterner normalement.
Et avec la macro, uniquement pour la dernière ligne, la couleur reste constamment identique à la ligne précédente, même si les valeurs sont différentes :

erreur derniere ligne

J'ai essayé 2/3 modifications de code mais je n'arrive pas à ajuster ce petit problème

Je vous joins un fichier d'exemple avec la macro intégrée

En vous remerciant par avance pour votre aide

4macro-erreur-derniere-ligne.xlsm (29.85 Ko)
Le 15/04/2021 à 15:15

Bonjour,

Je n'ai pas eu de réponse sur la proposition faite...

Sinon voici un code, qui au lieu du blanc met "sans couleur" la cellule.

Sub couleur()
Ligne =1
Do
If cells(ligne + 1,1) = cells(ligne, 1) then
Cells(ligne+1,1).Resize(,150).interior.colorindex = cells(ligne, 1).interior.colorindex
Elseif cells(ligne+1,1)<>"" then
If cells(ligne,1).interior.colorindex =-4142 then
Cells(ligne+1,1).resize(, 150).interior.colorindex = 15
Else
Cells(ligne+1,1).Resize(,150).interior.colorindex =-4142
End if
End if
Ligne = ligne + 1
Loop while cells(ligne, 1) <>""
End sub

@ bientôt

LouReeD

Le 15/04/2021 à 16:57

Bonjour tout le monde. En fin de compte il est plus facile de reprendre tout à zéro que d'essayer de corriger. Nouvelle proposition très simple :

Sub ReperRefs()
    Dim NbItemsSource As Long, coul As Integer
    Dim i As Long, T As Integer, X As Integer
    Dim ws As Worksheet

    Set ws = Sheets("Feuil1")
    NbItemsSource = Sheets("Feuil1").Cells(Columns.Count, 1).End(xlUp).Row - 2
    T = 3  ' 1
    X = 4  ' 2
    i = 3

    coul = X
    ws.Range(ws.Cells(i, 1), ws.Cells(i, 150)).Interior.ColorIndex = coul
    Do
        If ws.Cells(i + 1, 1).Value <> ws.Cells(i, 1).Value Then
            If coul = X Then coul = T Else coul = X
        End If
        ws.Range(ws.Cells(i + 1, 1), ws.Cells(i + 1, 150)).Interior.ColorIndex = coul
        i = i + 1
    Loop Until i = NbItemsSource + 2
End Sub

J'ai mis d'autres couleurs pour qu'on voie le contenu.

Le 16/04/2021 à 10:52

Bonjour LouReeD et Optimix,

J'ai testé vos 2 propositions, mais aucune des 2 n'a fonctionné de mon côté.

Pour celle d'Optimix, la fenêtre suivante s'affiche lorsque j'exécute la macro, elle ne s'applique donc pas :

test optimix

Pour celle de LouReeD, la mise en forme se retire sur l'ensemble des lignes à partir de la 2ème :

test loureed

Avez-vous une idée de pourquoi ça fait cela ?

Je vous remet en PJ le fichier pour tester la macro

4macro-erreur-derniere-ligne.xlsm (29.39 Ko)

Merci par avance pour vos retours

Le 16/04/2021 à 12:02

Bonjour et oups !

sur la ligne : If cells(ligne+1,1).interior.colorindex =-4142 then

retirez le "+1"

Et vu votre tableau il faut initier ligne à 3 au lieu de 2

@ bientôt

LouReeD

Le 16/04/2021 à 13:19

Il suffisait de vérifier le nom de la feuille.

5cellules-vertes.xlsm (20.89 Ko)
Le 16/04/2021 à 14:39

Merci beaucoup

La macro fonctionne parfaitement !

Bonne journée à vous 2

Le 09/05/2021 à 09:43

Bonjour

Merci pour vos remerciements !

@ bientôt

LouReeD

Rechercher des sujets similaires à "ignorer premieres lignes macro existante jointe"