XL 2013 Colorier les cellules texte identique et changer de couleur si cellule différentes

Dye

XLDnaute Nouveau
Bonjour la communauté,

Je suis nouveau sur le forum et après avoir cherché au sein du forum en vain je pose ma problématique de façon détaillée car la chose n'est pas simple pour un novice comme moi.

On rentre un type de salle, type de sol, risque incendie, niveau de panique et équipement, pour chaque type de salle on a une description correspondante.
On peut avoir un nombre indéfini de type de salle...(en moyenne 25 max)

Une fois l'ensemble des descriptions faites ("feuille 1"), l'analyse commence...

En effet, je souhaiterais colorier d'une couleur les cellules textes identiques de la colonne H (feuille "copie de résultat") et d'une couleur différente chaque cellule différentes, afin de regrouper le type de salle identique par couleur.

L'idée par la suite et de voir le nombre de type de salle aux caractéristiques identiques grâce aux couleurs et de mettre sur la "feuille 1" le nombre de couleur différentes en les appelant zones.

Par exemple si l'on obtient 7 couleurs différentes faire une synthèse sur la feuille 1 avec zone 1 en rouge .....Zone 7 en jaune.

A noter que j'ai colorié et synthétisé les résultats de façon manuelle sur la feuille 1, je souhaite faire tout cela automatiquement.

Je joint mon fichier afin que vous ayez une idée plus claire de la montagne que je n'arrive pas encore à franchir.

Merci à vous de me faire votre retour si vous souhaitez des informations complémentaires.

@ bientôt
 

Pièces jointes

  • définition des zones.xlsx
    18.8 KB · Affichages: 77

JBARBE

XLDnaute Barbatruc
Re : Colorier les cellules texte identique et changer de couleur si cellule différent

Bonjour à tous,

Dans la feuille "Copie de resultat"!

En sélectionnant dans la colonne F et après avoir fait son choix dans les colonnes C - D - E , la ligne correspondante se colorie !

En cas d'erreur de sélection dans les colonnes, un message est affiché demandant de recommencer !

bonne journée !
 

Pièces jointes

  • définition des zones.xlsm
    34 KB · Affichages: 80

PMO2

XLDnaute Accro
Re : Colorier les cellules texte identique et changer de couleur si cellule différent

Bonjour,

Une piste qui utilise l'événement Worksheet_Change de la feuille concernée.
Chaque fois qu'un changement s'opère dans la plage C4:Fx la procédure MultiColors est appelée.

1) Copiez le code suivant dans un module Standard
Code:
'////////////////////////////////////////////////////////
'/// Si vous voulez utiliser la procédure directement en
'/// l'appelant par la boîte de macro OU en la lançant à
'/// partir du VBE (Visual Basic Editor), il faut retirer
'/// l'argument Optional dummy As Byte comme suit
'Sub MultiColors()
'////////////////////////////////////////////////////////
Sub MultiColors(Optional dummy As Byte)
Const SEPARATEUR As String = "µ"
Dim S As Worksheet
Dim R As Range
Dim var
Dim i&
Dim j&
Dim k&
Dim A$
Dim Coll As New Collection
Dim Couleurs As Variant
'--- Les couleurs ---
Couleurs = Array(15773696, 12611584, 11324408, 1137349, _
     11722949, 65535, 255, 3506516, 10498160, 10086399, _
     192, 49407, 37568, 16182238, 13285804)
'--- La feuille et la plage concernées ---
Set S = ActiveSheet
Set R = S.Range("c4:h" & S.[b3].End(xlDown).Row & "")
'--- Effacement des couleurs de la plage ---
R.Interior.Color = xlNone
'--- Création de la collection sans doublon ---
var = R
For i& = 1 To UBound(var, 1)
  For j& = 1 To 4
    A$ = A$ & var(i&, j&)
  Next j&
  If A$ <> "" Then
    var(i&, 6) = A$
    On Error Resume Next
    Coll.Add Item:=A$ & SEPARATEUR & CStr(Couleurs(k&)), Key:=A$
    If Err = 0 Then
      k& = k& + 1
    Else
      Err.Clear
    End If
    On Error GoTo 0
    A$ = ""
  End If
Next i&
'--- Application des couleurs dans la plage ---
For i& = 1 To UBound(var, 1)
  For k& = 1 To Coll.Count
    A$ = var(i&, 6)
    If A$ = Mid(Coll.Item(k&), 1, Len(A$)) Then
      Set R = S.Range("c" & i& + 3 & ":f" & i& + 3 & "")
      R.Interior.Color = CLng(Mid(Coll.Item(k&), Len(A$) + 2))
    End If
  Next k&
Next i&
'--- Effacement des zones ---
Set R = S.Range("h4:h" & S.[b3].End(xlDown).Row & "")
R.ClearContents
'--- Création des zones ---
For k& = 1 To Coll.Count
  A$ = Coll.Item(k&)
  Set R = S.Range("h" & k& + 3 & "")
  R.Interior.Color = CLng(Mid(A$, InStr(1, A$, SEPARATEUR) + 1))
  R = "Zone" & k&
Next k&
End Sub

2) Copiez le code suivant dans la fenêtre de code de la feuille concernée
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim R As Range
'---
Set R = Range("c4:f" & [b3].End(xlDown).Row & "")
If Not Application.Intersect(Target, R) Is Nothing Then
  Application.EnableEvents = False
  Call MultiColors
  Application.EnableEvents = True
End If
End Sub
 

Pièces jointes

  • définition des zones_pmo.xlsm
    26.7 KB · Affichages: 60

Dye

XLDnaute Nouveau
Re : Colorier les cellules texte identique et changer de couleur si cellule différent

Bon jour à tous,

Un autre essai avec légende. les couleurs de fond et de police sont définies dans la seconde feuille.

Salut Ma pomme,

Merci d'avoir pris le temps de répondre à ma problématique et de façon claire.....^^

Cependant et afin de rendre le fichier plus "user friendly".....^^, penses tu qu'il soit possible d'ajouter un bouton reset (comme celui colorier) afin de retirer les couleurs pour modifier les paramètres dans le cas si un premier test à été effectué ....


De plus, j'aimerais également savoir si dans la synthèse des différentes couleurs mettre le nom des différents locaux du bâtiment au lieu des différents paramètres (exemple salle de classe , couloir,....).

N.B les cases dans lesquelles on rentre le nom du type de local du batiment peut être alphanumérique je ne sais pas si ça peut t'aider car les cases peuvent être nommé de différentes façons.

J'espère avoir été assez claire dans ma description .

Merci de d'avance de ton retour.

Dye


Merci d'avance de ton retour
 

JBARBE

XLDnaute Barbatruc
Re : Colorier les cellules texte identique et changer de couleur si cellule différent

Bonjour Dye, mapomme et PMO2,


Allons bon, voilà que PMO2 est devenu transparent, lui aussi :eek:

Bonjour à tous,

Et moi, je dois puer de la gueule !

Mais bon, je vais finir par ne plus apporter ma contribution à ce forum !

Et puis, il y a tellement de balaises de la formule et de la macro, que je peux me reposer !

Bonne journée quand même !
 

Modeste

XLDnaute Barbatruc
Re : Colorier les cellules texte identique et changer de couleur si cellule différent

Salut JBARBE,

Désolé d'avoir oublié de te saluer (même si j'avais vu ta proposition)
... et puis nous sommes tous frappés de transparence à un moment ou l'autre (pas une raison pour s'emballer!)
 

JBARBE

XLDnaute Barbatruc
Re : Colorier les cellules texte identique et changer de couleur si cellule différent

Merci Modeste d'avoir répondu !

Certes, ce n'est pas la première fois que comme tu le dis on est tous frappés de transparence à un moment ou l'autre, mais quant-on a passé plusieurs heures voir plusieurs jours et cela bénévolement, pour résoudre un problème, et que l'on se comporte comme Dye , il y a de quoi avoir mal au ventre !

Il m'est arrivé de passer plusieurs jours à faire un programme entier, et la moindre des choses est de remercier le concepteur !

Bonne journée à tous !
 

Discussions similaires

Statistiques des forums

Discussions
312 083
Messages
2 085 188
Membres
102 809
dernier inscrit
Sandrine83