colorer une cellule si identique à une autre

**Peerl** · 03/12/2019, 14h57

Bonjour,

j'ai un code qui détecte un changement de la cellule existante et lui donne une couleur (bleu par exemple).
je souhaite colorer toutes valeurs identique à la cellule bleu en jaune par exemple.

résultat :

cellule bleu( car valeur modifié)
cellule jaune ( car valeur identique aux cellules bleu)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
// changer la couleur de ma cellule si on détecte une modification 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Valeur
    Application.EnableEvents = False
    Valeur = Target
    Application.Undo
        If Target.Value <> Valeur Then
            Target.Interior.ColorIndex = 23
        End If
    Target = Valeur
    Application.EnableEvents = True
End Sub

merci pour votre aide

**tototiti2008** · 03/12/2019, 15h02

Bonjour Peerl,

Dans quelle plage les cellules jaunes ?

**Peerl** · 03/12/2019, 15h33

Re,

je pensais que c'était pas nécessaire comme il doit chercher dans toutes la feuilles mais sinon c'est à partir de F jusqu'à DP ( y a bcp de données)
merci

**tototiti2008** · 03/12/2019, 18h34

Re,

un truc comme ça peut-être

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Valeur, Tablo, Plage As Range, i As Long, j As Long
 
    Valeur = Target.Value
    Set Plage = Range("F1:DP10000")
    Plage.Interior.ColorIndex = xlNone
    Tablo = Plage.Value
    For i = 1 To UBound(Tablo, 1)
        For j = 1 To UBound(Tablo, 2)
            If Tablo(i, j) = Valeur Then
                Plage.Cells(i, j).Interior.Color = RGB(255, 255, 0)
            End If
        Next j
    Next i
    Target.Interior.Color = RGB(0, 0, 255)
    Erase Tablo
    Set Plage = Nothing
 
End Sub

Plus la plage à scanner est grande, plus c'est long...

**Peerl** · 04/12/2019, 10h02

Good Mornin,

Je vais tester et je te tiens au courant par contre il me semble que je dois activer le gestionnaire des événements pour que ce code s’exécute ?

**tototiti2008** · 04/12/2019, 10h22

Bonjour,

Oui, Worksheet_Change est un événement de la feuille

**Peerl** · 04/12/2019, 10h34

Honnêtement j'ai oublié comment on fait pour activer le gestionnaire... si tu peux m'éclairer STP

**tototiti2008** · 04/12/2019, 10h40

Copié de ton code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.EnableEvents = True

**Peerl** · 04/12/2019, 10h59

Je me sens bête lol

mais c'est parce que ça s’exécute pas quand je sélectionne mon code dans le module classe et que j'appuie sur exécuter j'ai une fenêtre de d'autres macros qui s'affiche pour choisir une macro à exécuter donc il reconnait pas mon code..

**tototiti2008** · 04/12/2019, 11h11

Re,

Si tu as réactivé les événements

(crée une Sub dans un module, colle Application.enableevents=true, clique dessus puis sur la flèche verte)

Colle mon code (Worksheet_change) dans la feuille concernée
Tu ne peux pas avoir 2 Worksheet_change, il faudra enlever le tien

Du côté Excel, dans ta feuille, tapes une valeur dans une cellule

**Peerl** · 04/12/2019, 11h24

Je comprends mieux, merci j'ai testé et le code s'exécute avec une erreur incompatibilité type 13 sur la ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If Tablo(i, j) = Valeur Then

Et l'idée au départ comme je comprenais pas très bien le principe du gestionnaire d’événements je pensais que je pouvais le mettre dans un module class pour pouvoir l'utiliser sur des feuilles dupliquées ( copier une feuille et exécuté le code )

**tototiti2008** · 04/12/2019, 11h44

Re,

comme je comprenais pas très bien le principe du gestionnaire d’événements je pensais que je pouvais le mettre dans un module class pour pouvoir l'utiliser sur des feuilles dupliquées

Faut déjà avoir un code qui fonctionne sur une feuille, on verra pour la classe ensuite

erreur incompatibilité type 13

Je n'arrive pas à reproduire, va falloir commencer à regarder tes données
Que vaut Valeur quand ça plante ? Que vaut Tablo(i,j) ?

**tototiti2008** · 04/12/2019, 11h48

Essaye de modifier la ligne comme ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If CStr(Tablo(i, j)) = CStr(Valeur) Then

**Peerl** · 04/12/2019, 11h59

Alors là ça fonctionne comme de la magie !! mais le principe avec ce code c'est que ça se réinitialise alors que je veux garder les couleurs de toutes les modifications

**tototiti2008** · 04/12/2019, 12h06

C'est pas très stable, plus d'un million de cellules testées à chaque saisie, ça ne m'étonnerais pas que ça puisse entraîner des plantages...

mais le principe avec ce code c'est que ça se réinitialise alors que je veux garder les couleurs de toutes les modifications

tout deviendra jaune au fur et à mesure ?
si oui, mets la ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Plage.Interior.ColorIndex = xlNone

en commentaire

**Peerl** · 04/12/2019, 12h22

tout deviendra jaune au fur et à mesure ?

toute cellule modifiée reste bleu et les jaunes restes jaunes ,

J'ai testé cette ligne qui existe déjà dans le code précédent mais aucun changement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Plage.Interior.ColorIndex = xlNone

en commentaire[/QUOTE]

**tototiti2008** · 04/12/2019, 12h39

tu as tapé une apostrophe au début de cette ligne ?

**Peerl** · 04/12/2019, 13h49

Envoyé par tototiti2008

tu as tapé une apostrophe au début de cette ligne ?

Non je ne l'ai pas mis en commentaire

**Peerl** · 04/12/2019, 16h57

Envoyé par tototiti2008

tout deviendra jaune au fur et à mesure ?
si oui, mets la ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Plage.Interior.ColorIndex = xlNone

en commentaire

Je viens de comprendre enfaite il faut mettre ça en commentaire et tester. Bon ça fonctionne ça se réinitialise pas Merci je suis sauvé pour cette étape.
Sinon, si je veux l'utiliser sur plusieurs feuille, est il possible de passer par le module?

**tototiti2008** · 04/12/2019, 17h16

Re,

il y a plusieurs façons de faire
Par exemple, tu peux simplement copier le code dans chacune des feuilles concernées

ou alors si tu veux que ça s'applique à toutes les feuilles du classeur, tu peux mettre ce code dans Thisworkbook

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Valeur, Tablo, Plage As Range, i As Long, j As Long
 
    Valeur = Target.Value
    Set Plage = Sh.Range("F1:DP10000")
    'Plage.Interior.ColorIndex = xlNone
    Tablo = Plage.Value
    For i = 1 To UBound(Tablo, 1)
        For j = 1 To UBound(Tablo, 2)
            If CStr(Tablo(i, j)) = CStr(Valeur) Then
                Plage.Cells(i, j).Interior.Color = RGB(255, 255, 0)
            End If
        Next j
    Next i
    Target.Interior.Color = RGB(0, 0, 255)
    Erase Tablo
    Set Plage = Nothing
 
End Sub

Et effacer le code de chaque feuille (worksheet_change)

colorer une cellule si identique à une autre

Macros et VBA Excel

Discussions similaires

Partager

Partager