Macro colorer cellule

Résolu
Loriiiis Messages postés 22 Statut Membre -  
Loriiiis Messages postés 22 Statut Membre -
Bonjour à tous,
J'ai une colonne L où se trouve plusieurs nom de personnes
Je voudrais un bouton (donc macro il me semble) ou quand je clique dessus tous les Fabien (par exemple) se mettent en couleur. Et quand on reclic tout redevient normal.
Ceci est possible par la mise en forme conditionnelle mais on ne peut pas revenir à la normal sans tout refaire le processus....
Est-ce possible ?
En attente de vous lire, merci d'avance
Loris,

2 réponses

  1.
    f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Bonjour,

    un exemple:
    double clic sur un prenom, toutes les cellules de ce prenom passent en vert
    double clic sur le meme prenom ou double clic sur un autre prenom passage sans couleur du prenom precedent et passage en vert du prenom en cour

    https://www.cjoint.com/c/FLBnZE6P0rf

    Code dans VBA de le feuille
    2
    1. Loriiiis Messages postés 22 Statut Membre
       
      c'est exactement ce que je cherchais ! Mais peut on rajouter une option ou quand on clique sur une cellule vide plus aucun prenom n'est coloré ?
      Et ne m'y connaissant pas, comment rentrer ce que vous avez fait dans mon tableur et que cela fonctionne ?
      0
      1. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717 > Loriiiis Messages postés 22 Statut Membre
         
        Bonjour,

        code a copier dans VBA de la feuille: 
        Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Count > 1 Then Exit Sub
    derlig = Range("A" & Rows.Count).End(xlUp).Row
    If Not Application.Intersect(Target, Range("A2:A" & derlig)) Is Nothing Then
        Cancel = True
        Application.ScreenUpdating = False
        Cel = Target.Value
        Range("A2:A" & derlig).Interior.Pattern = xlNone
        Nb = Application.CountIf(Columns(1), Cel)
        If Nb > 0 Then
            lig = 2 'ligne de depart

            For N = 1 To Nb
                lig = Columns(1).Find(Cel, Cells(lig, 1), , xlWhole).Row
                If Cells(lig, 1).Interior.Color = vbGreen Then
                    Cells(lig, 1).Interior.Pattern = xlNone
                Else
                    Cells(lig, 1).Interior.Color = vbGreen
                End If
            Next N
        End If
    End If
    Application.ScreenUpdating = True
End Sub

'clic droit sur cellules colonne A pour enlever couleur
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Count > 1 Then Exit Sub
    derlig = Range("A" & Rows.Count).End(xlUp).Row
    If Not Application.Intersect(Target, Range("A2:A" & derlig)) Is Nothing Then
        Cancel = True
        Range("A2:A" & derlig).Interior.Pattern = xlNone
    End If
End Sub

        Pour ouvrir la fenetre VBA, appuyez sur touches alt+F11, double clic sur la feuille en haut a gauche, copier/coller le code et essayez
        0
  2. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Re,

    aperçu de la fenetre VBA avec code dans feuille

    0
    1. Loriiiis Messages postés 22 Statut Membre
       
      Merci bien pour votre code, mais étant totalement incompétent (et je m'en excuse) en programmation, j'ai réussi à ouvrir la fenêtre via alt+F11 et puis je suis bloquer....
      Je voulais également savoir si cette fonction de couleur selon le texte marche sur toute les colonnes ou uniquement sur celle souhaité (dans mon cas L) ?
      0
    2. Loriiiis Messages postés 22 Statut Membre > Loriiiis Messages postés 22 Statut Membre
       
      Alors après recherche j'ai réussis à inserer mon code... Le probleme c'est qu'il marche pour la colonne A uniquement. Je le voudrais si possible sur la L
      0
    3. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717 > Loriiiis Messages postés 22 Statut Membre
       
      Bonjour,

      Colonne L 
      Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Count > 1 Then Exit Sub
    derlig = Range("L" & Rows.Count).End(xlUp).Row
    If Not Application.Intersect(Target, Range("L2:L" & derlig)) Is Nothing Then
        Cancel = True
        Application.ScreenUpdating = False
        Cel = Target.Value
        Range("L2:L" & derlig).Interior.Pattern = xlNone
        Nb = Application.CountIf(Columns(12), Cel)
        If Nb > 0 Then
            lig = 2 'ligne de depart

            For N = 1 To Nb
                lig = Columns(12).Find(Cel, Cells(lig, 12), , xlWhole).Row
                If Cells(lig, 12).Interior.Color = vbGreen Then
                    Cells(lig, 12).Interior.Pattern = xlNone
                Else
                    Cells(lig, 12).Interior.Color = vbGreen
                End If
            Next N
        End If
    End If
    Application.ScreenUpdating = True
End Sub

'clic droit sur cellules colonne A pour enlever couleur
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Count > 1 Then Exit Sub
    derlig = Range("L" & Rows.Count).End(xlUp).Row
    If Not Application.Intersect(Target, Range("L2:L" & derlig)) Is Nothing Then
        Cancel = True
        Range("L2:L" & derlig).Interior.Pattern = xlNone
    End If
End Sub
      0
    4. Loriiiis Messages postés 22 Statut Membre > f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention  
       
      Merci beaucoup d'avoir pris le temps de répondre à ce post, c'est très gentil. Toutefois si vous accepté de prendre encore quelque minutes pour compléter cette macro ce serai vraiment sympathique. je m'explique :
      Tous les prénoms sont recensés (1 fois chacun) dans la colonne Q à partir de la ligne 47 jusqu’à infinis puisque je remets des prénoms tous les mois.
      - Serait-il possible qu'eux se mettent également en couleur via le double clic ? (En synchronisation avec la colonne L)
      - Peut-on ajouter une option où aucune cellule n'est coloré (double clic dans la colonne N par exemple)
      J'insiste sur le fais que vous m'avez déjà bien aidé (je vous en remercie encore) et que je comprendrais que vous n'ayez pas envie de résoudre ces 2 petits soucis qu'il me reste.
      Bien cordialement,
      0
    5. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717 > Loriiiis Messages postés 22 Statut Membre
       
      Bonjour,

      Ok, mais
      - Peut-on ajouter une option où aucune cellule n'est coloré (double clic dans la colonne N par exemple)
      Vous avez deja le clic droit sur colonne L!!!!!!!!!!!!!!!! 


      Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Count > 1 Then Exit Sub
    derlig = Range("L" & Rows.Count).End(xlUp).Row
    If Not Application.Intersect(Target, Range("L2:L" & derlig)) Is Nothing Then
        Cancel = True
        Application.ScreenUpdating = False
        Cel = Target.Value
        Range("L2:L" & derlig).Interior.Pattern = xlNone
        Nb = Application.CountIf(Columns(12), Cel)
        If Nb > 0 Then
            lig = 2 'ligne de depart
            For N = 1 To Nb
                lig = Columns(12).Find(Cel, Cells(lig, 12), , xlWhole).Row
                If Cells(lig, 12).Interior.Color = vbGreen Then
                    Cells(lig, 12).Interior.Pattern = xlNone
                Else
                    Cells(lig, 12).Interior.Color = vbGreen
                End If
            Next N
        End If
        derlig = Range("Q" & Rows.Count).End(xlUp).Row
        Range("Q47:Q" & derlig).Interior.Pattern = xlNone
        Nb = Application.CountIf(Columns(17), Cel)
        If Nb > 0 Then
            lig = 47 'ligne de depart
            For N = 1 To Nb
                lig = Columns(17).Find(Cel, Cells(lig, 17), , xlWhole).Row
                If Cells(lig, 17).Interior.Color = vbGreen Then
                    Cells(lig, 17).Interior.Pattern = xlNone
                Else
                    Cells(lig, 17).Interior.Color = vbGreen
                End If
            Next N
        End If
    End If
    Application.ScreenUpdating = True
End Sub

'clic droit sur cellules colonne Q et L pour enlever couleur
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Count > 1 Then Exit Sub
    derligL = Range("L" & Rows.Count).End(xlUp).Row
    derligQ = Range("Q" & Rows.Count).End(xlUp).Row
    If Not Application.Intersect(Target, Range("L2:L" & derlig)) Is Nothing Then
        Cancel = True
        Range("L2:L" & derligL).Interior.Pattern = xlNone
        Range("Q47:Q" & derligQ).Interior.Pattern = xlNone
    End If
End Sub
      0

Discussions similaires

Excel formule : savoir si une cellule contient partie texte
plunderer007 -
francois -

14 réponses
Excel : colorer une cellule sous condition d'une autre ?
KAKEPATHEL -
Pascal -

15 réponses
Transformer un chiffre en lettres dans excel sans macro
vincentphilippos -
tontong -

6 réponses