Faire ressortir les éléments communs d'un tableau

ibicus · 15 Octobre 2010

Bonsoir,
Je m'en remets à vous pour trouver une solution à mon problème, car là je ne sais plus, et ce n'est pas faute d'avoir (mal?) cherché, je n'en compte plus les heures. Pourtant, cela n'a pas l'air compliqué dans la théorie. Je m'explique.
Le tableau ci joint est une synthèse d'analyses. Il se remplira chaque mois "automatiquement" par liaison avec d'autres feuilles excel, avec l'aide de macros. Ce tableau représentera les dix produits qui auront posé le plus de problèmes sur chaque mois avec comme critère le coût. Jusqu'ici, j'ai réussi à me débrouiller.

Ce que j'aimerai, et que je n'arrive pas à faire, c'est qu'après chaque remplissage d'un tableau (d'un mois), il y ai une analyse de toutes les références présentent et que cette analyse fasse ressortir toutes celles qui sont identiques par coloration de la cellule (juste la cellule des références). Ainsi, j'aurai une vision rapide des problèmes lorsqu'ils se répètent. Le top du top serait d'avoir une couleur différente pour différencier les références communes. Même si là, je ne sais pas si j'exploserai le nombre de couleurs disponible.
Il peut y avoir des références communes dans une colonne (si,si) donc, il faut une analyse ligne et colonnes. Si j'ai une préférence à formuler, ce serait pour une macro. Je peux mettre un bouton général devant le tableau, qui sera actionné après chaque remplissage, si cela suffit, ou un bouton pour chaque mois.
Voilà, je vous laisse avec mon problème, que je sais entre bonnes mains. Je reste bien sûr à votre disposition pour tout complément d'information si je n'ai pas été assez clair, ce qui ne serait pas étonnant vu qu'il est tard et que je n'ai plus trop les yeux en face des trous.
et merci d'avance de vous occuper de mon cas.

Banzai64 · 15 Octobre 2010

Re : Faire ressortir les éléments communs d'un tableau

Bonjour

Un essai

ROGER2327 · 15 Octobre 2010

Re : Faire ressortir les éléments communs d'un tableau

Bonjour à tous

Un autre essai...
Le code est adapté au classeur modèle, mais assez facilement adaptable à d'autres contextes.

Code:

[COLOR="DarkSlateGray"][B]Sub toto()
Dim i&, j&, k&, rTmp$, rClri%, Clri
Dim tRef As Range, iRef As Range, nRef%(), CollRef As New Collection
  Clri = Array(-3, 4, -5, 6, 7, 8, -9, -10, -11, -12, -13, -14, 15, -16, 17, -18, 20, -21, 22, -23, 24, -25, 26, -53, 28, -29, -30, -31, -32, 33)
  Set tRef = Cells(2, 1).Resize(1, Cells(2, Columns.Count).End(xlToLeft).Column)
  With Application: .ScreenUpdating = 0: .Calculation = -4135: .EnableEvents = 0: End With
  For i = 1 To tRef.Cells.Count
    If tRef.Cells(1, i).Value = "Référence" Then
      Set iRef = Range(tRef.Cells(1, i), Cells(13, i).End(xlUp))
      With iRef.Offset(1, 0).Resize(10, 1): .Interior.ColorIndex = xlColorIndexNone: .Font.ColorIndex = xlColorIndexAutomatic: End With
      On Error Resume Next
      For j = 2 To iRef.Cells.Count
        If iRef.Cells(j, 1).Value <> "" Then CollRef.Add iRef.Cells(j, 1).Value, CStr(iRef.Cells(j, 1).Value)
      Next j
      On Error GoTo 0
    End If
  Next i
  With Application: .EnableEvents = 1: .Calculation = -4105: .ScreenUpdating = 1: End With
  If CollRef.Count = 0 Then Exit Sub
  ReDim nRef(1 To CollRef.Count)
  For k = 1 To CollRef.Count
    rTmp = CollRef(k)
    For i = 1 To tRef.Cells.Count
      If tRef.Cells(1, i).Value = "Référence" Then
        Set iRef = Range(tRef.Cells(1, i), Cells(13, i).End(xlUp))
        For j = 2 To iRef.Cells.Count
          If iRef.Cells(j, 1).Value = rTmp Then nRef(k) = nRef(k) + 1
        Next j
      End If
    Next i
  Next k
  With Application: .ScreenUpdating = 0: .Calculation = -4135: .EnableEvents = 0: End With
  For k = 1 To CollRef.Count
    If nRef(k) > 1 Then
      rTmp = CollRef(k)
      For i = 1 To tRef.Cells.Count
        If tRef.Cells(1, i).Value = "Référence" Then
          Set iRef = Range(tRef.Cells(1, i), Cells(13, i).End(xlUp))
          For j = 2 To iRef.Cells.Count
            If iRef.Cells(j, 1).Value = rTmp Then
              iRef.Cells(j, 1).Interior.ColorIndex = Abs(Clri(rClri Mod (1 + UBound(Clri))))
              iRef.Cells(j, 1).Font.ColorIndex = 1 - Sgn(Clri(rClri Mod (1 + UBound(Clri))))
            End If
          Next j
        End If
      Next i
      rClri = rClri + 1
    End If
  Next k
  With Application: .EnableEvents = 1: .Calculation = -4105: .ScreenUpdating = 1: End With
End Sub[/B][/COLOR]

(À placer dans le module de la feuille concernée.
Bien entendu, seuls les doublons apparaissant dans les colonnes Référence, lignes 3 à 12, sont pris en compte.
La ligne 13 de cette feuille doit être vide, mais on peut disposer du reste de la feuille.)

ROGER2327
#4313

Mardi 10 Haha 138 (Saint Panmuphle, huissier, SQ)
24 Vendémiaire An CCXIX
2010-W41-5T02:10:43Z

ibicus · 15 Octobre 2010

Re : Faire ressortir les éléments communs d'un tableau

Wahou!! Se rendre compte que des personnes se sont penchées sur mon problème pendant que je dormais est super touchant.

Bonjour et un grand merci pour cela.

Je regarde tout cela à tête reposée ce soir et vous tient informé.

ibicus · 16 Octobre 2010

Re : Faire ressortir les éléments communs d'un tableau

Messieurs,
C'est tout à fait ce que je voulais, avec, désolé Banzai64. une préférence pour le travail de ROGER2327, car j'ai d'autres tableaux sur ma feuille, et je ne peux pas perdre leurs couleurs.

J'ai encore un petit service à vous demander ROGER2327. Je n'ai pas eu la présence d'esprit, quand j'ai envoyé mon tableau, de le positionner au même endroit que sur mon classeur. Il est en E20, et non en A1
Bien sûr, j'ai essayé de bidouiller le programme pour l'ajuster à ce décalage, mais il y a des données qui m'échappent, et je n'arrive pas à prendre en compte tout le tableau.
Si vous voulez bien m'accorder encore un peu de votre temps pour me régler cela, je vous en serais reconnaissant.

ROGER2327 · 16 Octobre 2010

Re : Faire ressortir les éléments communs d'un tableau

Re...

Comme je l'ai dit plus haut, le code est facilement adaptable, au prix d'une modification modeste (les modifications sont en rouge).

Pour le code principal :

Code:

[COLOR="DarkSlateGray"][B]Sub toto([COLOR="Red"]l&, d&, c&[/COLOR])
Dim [COLOR="Red"]f&[/COLOR], i&, j&, k&, rTmp$, rClri%, Clri
Dim tRef As Range, iRef As Range, nRef%(), CollRef As New Collection
  Clri = Array(-3, 4, -5, 6, 7, 8, -9, -10, -11, -12, -13, -14, 15, -16, 17, -18, 20, -21, 22, -23, 24, -25, 26, -53, 28, -29, -30, -31, -32, 33)
  [COLOR="Red"]f = d + l + 1[/COLOR]
  Set tRef = Cells([COLOR="Red"]d[/COLOR], [COLOR="Red"]c[/COLOR]).Resize(1, Cells([COLOR="Red"]d[/COLOR], Columns.Count).End(xlToLeft).Column)
  With Application: .ScreenUpdating = 0: .Calculation = -4135: .EnableEvents = 0: End With
  For i = 1 To tRef.Cells.Count
    If tRef.Cells(1, i).Value = "Référence" Then
      Set iRef = Range(tRef.Cells(1, i), Cells([COLOR="Red"]f[/COLOR], [COLOR="Red"]i + c - 1[/COLOR]).End(xlUp))
      With iRef.Offset(1, 0).Resize([COLOR="Red"]l[/COLOR], 1): .Interior.ColorIndex = xlColorIndexNone: .Font.ColorIndex = xlColorIndexAutomatic: End With
      On Error Resume Next
      For j = 2 To iRef.Cells.Count
        If iRef.Cells(j, 1).Value <> "" Then CollRef.Add iRef.Cells(j, 1).Value, CStr(iRef.Cells(j, 1).Value)
      Next j
      On Error GoTo 0
    End If
  Next i
  With Application: .EnableEvents = 1: .Calculation = -4105: .ScreenUpdating = 1: End With
  If CollRef.Count = 0 Then Exit Sub
  ReDim nRef(1 To CollRef.Count)
  For k = 1 To CollRef.Count
    rTmp = CollRef(k)
    For i = 1 To tRef.Cells.Count
      If tRef.Cells(1, i).Value = "Référence" Then
        Set iRef = Range(tRef.Cells(1, i), Cells([COLOR="Red"]f[/COLOR], [COLOR="Red"]i + c - 1[/COLOR]).End(xlUp))
        For j = 2 To iRef.Cells.Count
          If iRef.Cells(j, 1).Value = rTmp Then nRef(k) = nRef(k) + 1
        Next j
      End If
    Next i
  Next k
  With Application: .ScreenUpdating = 0: .Calculation = -4135: .EnableEvents = 0: End With
  For k = 1 To CollRef.Count
    If nRef(k) > 1 Then
      rTmp = CollRef(k)
      For i = 1 To tRef.Cells.Count
        If tRef.Cells(1, i).Value = "Référence" Then
          Set iRef = Range(tRef.Cells(1, i), Cells([COLOR="Red"]f[/COLOR], [COLOR="Red"]i + c - 1[/COLOR]).End(xlUp))
          For j = 2 To iRef.Cells.Count
            If iRef.Cells(j, 1).Value = rTmp Then
              iRef.Cells(j, 1).Interior.ColorIndex = Abs(Clri(rClri Mod (1 + UBound(Clri))))
              iRef.Cells(j, 1).Font.ColorIndex = 1 - Sgn(Clri(rClri Mod (1 + UBound(Clri))))
            End If
          Next j
        End If
      Next i
      rClri = rClri + 1
    End If
  Next k
  With Application: .EnableEvents = 1: .Calculation = -4105: .ScreenUpdating = 1: End With
End Sub[/B][/COLOR]

Pour le bouton :
Code:
```
[COLOR="DarkSlateGray"][B]Private Sub CommandButton1_Click()
  toto [COLOR="Red"]10, 21, 5[/COLOR]
End Sub[/B][/COLOR]
```
10 parce que le tableau possède dix lignes de données à traiter.
21 parce que la ligne des titres est la ligne 21, 5 parce que la première colonne de données est la cinquième.
(Pour le premier tableau, on aurait écrit toto 10, 2, 1)

Trois remarques :

Vous pouvez étendre le tableau vers la droite sans modifier le code.
Il convient que la première ligne sous le tableau reste vide.
La ligne
Code:
```
[COLOR="DarkSlateGray"][B]  Clri = Array(-3, 4, -5, 6, 7, 8, -9, -10, -11, -12, -13, -14, 15, -16, 17, -18, 20, -21, 22, -23, 24, -25, 26, -53, 28, -29, -30, -31, -32, 33)[/B][/COLOR]
```
correspond aux index des couleurs employées.
Vous pouvez ajouter ou supprimer des couleurs en modifiant cette ligne à volonté.

Le signe - (moins) indique que l'écriture se fait en blanc. Par exemple -3 : écriture en blanc sur fond rouge ; 4 : écriture en noir sur fond vert ; -5 : écriture en blanc sur fond bleu...

ROGER2327
#4320

Mercredi 11 Haha 138 (Sortie de Saint Lucas Cranach, apocalypticien, SQ)
25 Vendémiaire An CCXIX
2010-W41-6T00:11:57Z

ibicus · 16 Octobre 2010

Re : Faire ressortir les éléments communs d'un tableau

Bonjour Monsieur Roger2327,

Jusqu'à présent, j'ai réussi à me débrouiller tout seul.
Faute d'avoir su créer le programme, j'aurais aimé au moins l'adapter par moi même à la nouvelle position de mon tableau. J'ai essayé, mais je crois que j'ai atteint mes limites et qu'il me manque quelques bases qu'il va falloir que je comble par une formation.

En tout cas, grâce à votre contribution, j'ai ce que je voulais, c'était pour moi super important, et pour cela, je vous en suis très reconnaissant. Merci donc de m'avoir aidé.

ROGER2327 · 16 Octobre 2010

Re : Faire ressortir les éléments communs d'un tableau

Bonsoir ibicus

ibicus à dit:
(...)
Jusqu'à présent, j'ai réussi à me débrouiller tout seul.
Faute d'avoir su créer le programme, j'aurais aimé au moins l'adapter par moi même à la nouvelle position de mon tableau. J'ai essayé, mais je crois que j'ai atteint mes limites et qu'il me manque quelques bases qu'il va falloir que je comble par une formation.
(...)

Ne soyez pas inquiet ou découragé : avec le temps vous accumulerez des petits trucs et des automatismes qui feront que ce qui vous semble aujourd'hui compliqué deviendra simple. J'ai dit que les adaptations à faire n'étaient pas difficiles. C'est vrai (vous avez vu qu'il n'y a pas d'énorme changement), mais c'était facile pour moi car j'avais prévu qu'il faudrait peut-être faire ces adaptations. C'est beaucoup plus difficile quand on n'a pas fait soi-même le code ! (On n'est pas dans la tête des autres...)
J'espère que les modifications que j'ai proposées dans mon précédent message sont assez claires. Si ce n'est pas le cas, n'hésitez pas à le dire.

Cordialement,

ROGER2327
#4325

Mercredi 11 Haha 138 (Sortie de Saint Lucas Cranach, apocalypticien, SQ)
25 Vendémiaire An CCXIX
2010-W41-6T20:46:20Z

Effectuez une recherche sur Excel Downloads...

Faire ressortir les éléments communs d'un tableau

ibicus

XLDnaute Nouveau

Pièces jointes

Banzai64

XLDnaute Accro

Pièces jointes

ROGER2327

XLDnaute Barbatruc

Pièces jointes

ibicus

XLDnaute Nouveau

ibicus

XLDnaute Nouveau

Pièces jointes

ROGER2327

XLDnaute Barbatruc

Pièces jointes

ibicus

XLDnaute Nouveau

ROGER2327

XLDnaute Barbatruc

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums