Ratio des cellules par couleur

Le 15/05/2012 à 18:00

Bonjour,

Je suis en train de travailler sur un baromètre (résultat d'une enquête mené auprès de nos clients). J'ai une colonne de plus de 20000 lignes de commentaires et suggestions de nos clients. Après un rapide survol, j'ai noté les 5 grands thèmes les plus récurrents. Je voudrais faire un ratio de ces pour chacun de ces thèmes, ce qui me permettra de dire par exemple : "sur 20000 répondants, 25% trouvent que le conditionnement des produits laisse à désirer, 45% trouvent le SAV peu efficace...".

Le moyen le plus simple qui m'est venu à l'idée (je reste ouvert à toute autre proposition plus simple) est d’établir une couleur pour chaque thématique (rouge pour qualité SAV, bleu pour conditionnement...) et de colorier les cellules en fonction de la thématique auxquelles elles se rapportent. A l'issu de cela, compter le nombre de cellule rouge, bleu... pour faire les ratios.

Mon problème est que compter les cellules manuellement va me prendre un temps fou sans compter le risque d'erreur. Je voudrais donc savoir s'il y a une formule simple qui pourra me calculer le pourcentage de cellule rouge, bleu... dans la colonne des commentaires.

J'ai essayé d’être le plus explicite possible afin de vous aider à m'aider . Je reste aussi ouvert à toute proposition pour organiser ce baromètre plus facilement et efficacement.

Merci d'avance!

Cordialement!

Le 15/05/2012 à 19:06

bonjour

met une maquette de ton ouvrage pour voir la structure parce qu'a loccasion les couleurs seront inutiles ;il suffira de compter en fonction du critere theme et des sous criteres (satisfaction)

ps : avec 20000 lignes => vba

cordialement

Le 16/05/2012 à 10:48

Salut

Si j'ai bien compris, il faut compter les cellules d'une même couleur :

Dans excel:

ouvrir l'editeur de MAcro (ALT+F11)

Dans la partie de gauche, click droit sur Feuil1

Selectionner Insertion -> Module

Coller le code suivant :

Function NBcouleur(code_couleur As Integer, plage As Range) As Double
Dim c As Range
Dim compteur As Double

For Each c In plage

    If c.Cells.Interior.ColorIndex = code_couleur Then
        compteur = compteur + 1
    End If

Next
NBcouleur = compteur

End Function

Puis dans excel on pourra utiliser la formule comme suit :

=nbcouleur(6;G3:G23) Ou 6 est le code couleur pour le jaune.

Si tu ne connais pas le code de tes couleurs, copier a la suite du code ci dessus le code suivant :

Function trouvecouleur(cellule As Range) As Integer
    trouvecouleur = cellule.Interior.ColorIndex
End Function

Dans Excel tu utiliseras la fonction :

=trouvecouleur(G3)

qui te renverra la valeur 6 pour le jaune (exemple)

Après, pour faire le pourcentage, il suffit juste de compter le nombre total de ligne

Ca ta va ?

48comptecouleur.zip (8.25 Ko)
Le 25/06/2012 à 12:39

La calcul du nombre de couleurs marche bien lorsqu'il s'agit de couleurs issues de la fonction "format cellule"/"Remplissage".

Mais lorsque la couleur provient d'une mise en forme conditionnelle, il y a un problème. Si la mise en forme conditionnelle donne la couleur rouge ( normalement code "43" issu de "trouvecouleur"), "trouve couleur" donne "-4142" qui semble plutôt être le code de la mise en forme conditionnelle.

Comment peut-on faire pour ne récupérer que la couleur de cette mise en forme conditionnelle? L'idée étant de compter toutes les cellules pour lesquelles la mise en forme conditionnelles donne une couleur donnée?

D'avance merci

Le 25/06/2012 à 17:44

bonjour

pour traiter ce qui est issu de MFC c'est hyper compliqué ............

tu pourrais eventuellement te rabattre sur le comptage du critere de mfc

soit somme.couleur + nb.si ( plge; critere) cela peut etre nb.si ou autre

cordialement

Le 25/06/2012 à 18:13

Salut

Y a qqun qui a deja traité le sujet, (et oui c'est compliqué...)

http://www.cpearson.com/excel/CFColors.htm

Je ne sais pas si j'ai le droit de donner ce lien....

En utilisant la fomule :

=ColorIndexOfCF(B4) alors on retrouve le bon code couleur (issue ou non d'une mise en forme automatique.)

Il faut donc changer le code pour que cela fonctionne :

Function NBcouleur(code_couleur As Integer, plage As Range) As Double
Dim c As Range
Dim compteur As Double

For Each c In plage

    If ColorIndexOfCF(c) = code_couleur Then
        compteur = compteur + 1
    End If

Next
NBcouleur = compteur

End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function ActiveCondition(Rng As Range) As Integer
Dim Ndx As Long
Dim FC As FormatCondition
Dim Temp As Variant
Dim Temp2 As Variant

If Rng.FormatConditions.Count = 0 Then
    ActiveCondition = 0
Else
    For Ndx = 1 To Rng.FormatConditions.Count
        Set FC = Rng.FormatConditions(Ndx)
        Select Case FC.Type
            Case xlCellValue
            Select Case FC.Operator
                Case xlBetween
                    Temp = GetStrippedValue(FC.Formula1)
                    Temp2 = GetStrippedValue(FC.Formula2)
                    If IsNumeric(Temp) Then
                       If CDbl(Rng.Value) >= CDbl(FC.Formula1) And _
                           CDbl(Rng.Value) <= CDbl(FC.Formula2) Then
                           ActiveCondition = Ndx
                           Exit Function
                       End If
                   Else
                      If Rng.Value >= Temp And _
                         Rng.Value <= Temp2 Then
                         ActiveCondition = Ndx
                         Exit Function
                      End If
                   End If

                Case xlGreater
                    Temp = GetStrippedValue(FC.Formula1)
                    If IsNumeric(Temp) Then
                       If CDbl(Rng.Value) > CDbl(FC.Formula1) Then
                          ActiveCondition = Ndx
                          Exit Function
                       End If
                    Else
                       If Rng.Value > Temp Then
                          ActiveCondition = Ndx
                          Exit Function
                       End If
                    End If

                Case xlEqual
                    Temp = GetStrippedValue(FC.Formula1)
                    If IsNumeric(Temp) Then
                       If CDbl(Rng.Value) = CDbl(FC.Formula1) Then
                           ActiveCondition = Ndx
                           Exit Function
                       End If
                    Else
                       If Temp = Rng.Value Then
                          ActiveCondition = Ndx
                          Exit Function
                       End If
                    End If

                Case xlGreaterEqual
                    Temp = GetStrippedValue(FC.Formula1)
                    If IsNumeric(Temp) Then
                       If CDbl(Rng.Value) >= CDbl(FC.Formula1) Then
                           ActiveCondition = Ndx
                           Exit Function
                       End If
                    Else
                       If Rng.Value >= Temp Then
                          ActiveCondition = Ndx
                          Exit Function
                       End If
                    End If

                Case xlLess
                    Temp = GetStrippedValue(FC.Formula1)
                    If IsNumeric(Temp) Then
                        If CDbl(Rng.Value) < CDbl(FC.Formula1) Then
                           ActiveCondition = Ndx
                           Exit Function
                        End If
                    Else
                        If Rng.Value < Temp Then
                           ActiveCondition = Ndx
                           Exit Function
                        End If
                    End If

                Case xlLessEqual
                    Temp = GetStrippedValue(FC.Formula1)
                    If IsNumeric(Temp) Then
                       If CDbl(Rng.Value) <= CDbl(FC.Formula1) Then
                          ActiveCondition = Ndx
                          Exit Function
                       End If
                    Else
                       If Rng.Value <= Temp Then
                          ActiveCondition = Ndx
                          Exit Function
                       End If
                    End If

                Case xlNotEqual
                    Temp = GetStrippedValue(FC.Formula1)
                    If IsNumeric(Temp) Then
                       If CDbl(Rng.Value) <> CDbl(FC.Formula1) Then
                          ActiveCondition = Ndx
                          Exit Function
                       End If
                    Else
                       If Temp <> Rng.Value Then
                          ActiveCondition = Ndx
                          Exit Function
                       End If
                    End If

               Case xlNotBetween
                    Temp = GetStrippedValue(FC.Formula1)
                    Temp2 = GetStrippedValue(FC.Formula2)
                    If IsNumeric(Temp) Then
                       If Not (CDbl(Rng.Value) <= CDbl(FC.Formula1)) And _
                          (CDbl(Rng.Value) >= CDbl(FC.Formula2)) Then
                          ActiveCondition = Ndx
                          Exit Function
                       End If
                    Else
                       If Not Rng.Value <= Temp And _
                          Rng.Value >= Temp2 Then
                          ActiveCondition = Ndx
                          Exit Function
                       End If
                    End If

               Case Else
                    Debug.Print "UNKNOWN OPERATOR"
           End Select

        Case xlExpression
            If Application.Evaluate(FC.Formula1) Then
               ActiveCondition = Ndx
               Exit Function
            End If

        Case Else
            Debug.Print "UNKNOWN TYPE"
       End Select

    Next Ndx

End If

ActiveCondition = 0

End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function ColorIndexOfCF(Rng As Range, _
    Optional OfText As Boolean = False) As Integer

Dim AC As Integer
AC = ActiveCondition(Rng)
If AC = 0 Then
    If OfText = True Then
       ColorIndexOfCF = Rng.Font.ColorIndex
    Else
       ColorIndexOfCF = Rng.Interior.ColorIndex
    End If
Else
    If OfText = True Then
       ColorIndexOfCF = Rng.FormatConditions(AC).Font.ColorIndex
    Else
       ColorIndexOfCF = Rng.FormatConditions(AC).Interior.ColorIndex
    End If
End If

End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetStrippedValue(CF As String) As String
    Dim Temp As String
    If InStr(1, CF, "=", vbTextCompare) Then
       Temp = Mid(CF, 3, Len(CF) - 3)
       If Left(Temp, 1) = "=" Then
           Temp = Mid(Temp, 2)
       End If
    Else
       Temp = CF
    End If
    GetStrippedValue = Temp
End Function

Dis moi si cela te convient ?

Damien

Rechercher des sujets similaires à "ratio couleur"