Compter une cellule dans tout un classeur

Bonsoir Messieurs/dames!

Je me retrouve dans une impasse depuis plusieurs heures (j'y planche depuis ce matin...:aie:)

Voilà la situation:
Je suis en train de faire un inventaire.
J'ai de nombreuses feuilles identiques (une centaine actuellement).
Les seules différences entre celles-ci sont les couleurs de fond des cellules.

Exemple:

CarteSD | OUI | NON
CarteSDHC | OUI | NON
CartePCMIA | OUI | NON

Avec les cellules OUI ou NON verte en fonction de la présence de l'article ou non. (J'espere etre suffisamment clair...:oops::oops::oops:)

En toute dernière feuille du classeur, j'ai la feuille "BILAN".
Sur celle-ci, je souhaiterais faire la somme des articles de toutes les autres feuilles du classeur. C'est à dire, savoir combien il y a de OUI vert pour les cartes SD, pour les cartes SDHC...
Je souhaiterais mettre un bouton sur cette feuille qui calcule le nombre d'articles.
Pour l'instant, j'arrive à quelquechose de ce genre :
Premiere colonne : nom de l'article (il y a 20 articles différents)
Deuxieme colonne : nombre d'article

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19

Sub Calcul()   Dim Feuille As Worksheet Dim Cellule As Range Dim Total As Integer Dim i As Integer   For i = 3 To 23 Total = 0 'La, il faudrait que j'assimile la cellule du OUI à Cellule For Each Feuille In ActiveWorkbook.Worksheets If Cellule.Interior.ColorIndex = 43 Then Total = Total + 1 'La couleur 43 etant le vert... Next Feuille Sheets("BILAN").Select Cells(i, 2) = Total Next i   End Sub

---

Merci de me fournir votre aide à ce sujet!

Hilsen

bonsoir,

à quoi sert ton For i = 3 To 23 ?



si ton code est dans le même classeur que tes données remplace :

Code:

---

ActiveWorkbook.Worksheets

---

par

Code:

---

ThisWorkbook.Worksheets

---

moins on utilise ActiveWorkbook mieux l'on se porte ....;)

Code:

---

1 2	Sheets("BILAN").Select Cells(i, 2) = Total

---

Le select ne sert à rien .. :

Code:

---

ThisWorkBook.Sheets("BILAN").Cells(i, 2) = Total

---

elle sont ou tes cellules oui ? ligne / Colonne ?

Code:

---

If Cellule.Interior.ColorIndex = 43 Then Total = Total + 1 'La couleur 43 etant le vert...

---

ne peu tu pas calculer leur position en fonction de ton i ?

Code:

---

If Feuille.cells( i + ???, NoColonneOui).Interior.ColorIndex = 43 Then Total = Total + 1 'La couleur 43 étant le vert...

---

..

Mieux vaut des images que de long discours:

Citation:

---

Envoyé par Hilsen

Mieux vaut des images que de long discours:

---

un "petit discours" aurait c'est encore mieux .... , pas beaucoup d'effort pour dire que ton premier oui est en M5 ... soit cells(5,13). ..!

Code:

---

If Feuille.cells( i + 2,13).Interior.ColorIndex = 43 Then Total = Total + 1 'La couleur 43 étant le vert...

---

Cela me semble compliqué...
Les OUI/NON sont dans des colonnes différentes et des lignes différentes...

Voila ce que cela donne:

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37

Sub Calcul()   Dim Feuille As Worksheet Dim Cellule As Range Dim Total As Integer Dim i As Integer   For i = 3 To 23 Total = 0 If i = 3 Then Cellule = Range("O5") If i = 4 Then Cellule = Range("P5") If i = 5 Then Cellule = Range("O6") If i = 6 Then Cellule = Range("Q6") If i = 7 Then Cellule = Range("M5") If i = 8 Then Cellule = Range("M6") If i = 9 Then Cellule = Range("M7") If i = 10 Then Cellule = Range("R7") If i = 11 Then Cellule = Range("O8") If i = 12 Then Cellule = Range("P8") If i = 13 Then Cellule = Range("M9") If i = 14 Then Cellule = Range("M10") '+R10 If i = 15 Then Cellule = Range("M11") '+R11 If i = 16 Then Cellule = Range("M12") '+R12 If i = 17 Then Cellule = Range("M13") If i = 18 Then Cellule = Range("M14") If i = 19 Then Cellule = Range("R14") If i = 20 Then Cellule = Range("M15") If i = 21 Then Cellule = Range("R15") If i = 22 Then Cellule = Range("O17") '+O18+S17+S18 If i = 23 Then Cellule = Range("R21") For Each Feuille In ThisWorkbook.Worksheets If Cellule.Interior.ColorIndex = 43 Then Total = Total + 1 Next Feuille ThisWorkbook.Sheets("INVENTAIRE").Cells(i, 2) = Total Next i   End Sub

---

Mais comme je ne suis pas très doué dans la matiere, je pense que l'optimisation n'est pas mon mot d'ordre... :aie:

Je croyais le tableau mieux organisé...

tu peu utiliser un "tableau" de chaine pour stocker tes cellules :

Code:

---

1 2 3 4 5 6 7

Dim TbOui Dim Feuille As Worksheet '(...) TbOui = Array("O5", "P5", "O6", "Q6", "M5", "M6", "M7") ' A completer avec tes 23 ... valeurs... For Each Feuille In ThisWorkbook.Worksheets If Feuille.Range(TbOui(i - 3)).Interior.ColorIndex = 43 Then Total = Total + 1 Next Feuille

---

Voilà mon code final:

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35

Sub Calcul() ThisWorkbook.Sheets("INVENTAIRE").Range("B3:B23") = 0 Dim Feuille As Worksheet For Each Feuille In ThisWorkbook.Worksheets If Feuille.Range("O5").Interior.ColorIndex = 43 Then ThisWorkbook.Sheets("INVENTAIRE").Range("B3") = ThisWorkbook.Sheets("INVENTAIRE").Range("B3") + 1 If Feuille.Range("P5").Interior.ColorIndex = 43 Then ThisWorkbook.Sheets("INVENTAIRE").Range("B4") = ThisWorkbook.Sheets("INVENTAIRE").Range("B4") + 1 If Feuille.Range("O6").Interior.ColorIndex = 43 Then ThisWorkbook.Sheets("INVENTAIRE").Range("B5") = ThisWorkbook.Sheets("INVENTAIRE").Range("B5") + 1 If Feuille.Range("Q6").Interior.ColorIndex = 43 Then ThisWorkbook.Sheets("INVENTAIRE").Range("B6") = ThisWorkbook.Sheets("INVENTAIRE").Range("B6") + 1 If Feuille.Range("M7").Interior.ColorIndex = 43 Then ThisWorkbook.Sheets("INVENTAIRE").Range("B7") = ThisWorkbook.Sheets("INVENTAIRE").Range("B7") + 1 If Feuille.Range("M8").Interior.ColorIndex = 43 Then ThisWorkbook.Sheets("INVENTAIRE").Range("B8") = ThisWorkbook.Sheets("INVENTAIRE").Range("B8") + 1 If Feuille.Range("M9").Interior.ColorIndex = 43 Then ThisWorkbook.Sheets("INVENTAIRE").Range("B9") = ThisWorkbook.Sheets("INVENTAIRE").Range("B9") + 1 If Feuille.Range("R9").Interior.ColorIndex = 43 Then ThisWorkbook.Sheets("INVENTAIRE").Range("B10") = ThisWorkbook.Sheets("INVENTAIRE").Range("B10") + 1 If Feuille.Range("O10").Interior.ColorIndex = 43 Then ThisWorkbook.Sheets("INVENTAIRE").Range("B11") = ThisWorkbook.Sheets("INVENTAIRE").Range("B11") + 1 If Feuille.Range("P10").Interior.ColorIndex = 43 Then ThisWorkbook.Sheets("INVENTAIRE").Range("B12") = ThisWorkbook.Sheets("INVENTAIRE").Range("B12") + 1 If Feuille.Range("M11").Interior.ColorIndex = 43 Then ThisWorkbook.Sheets("INVENTAIRE").Range("B13") = ThisWorkbook.Sheets("INVENTAIRE").Range("B13") + 1 If Feuille.Range("M12").Interior.ColorIndex = 43 Then ThisWorkbook.Sheets("INVENTAIRE").Range("B14") = ThisWorkbook.Sheets("INVENTAIRE").Range("B14") + 1 If Feuille.Range("R12").Interior.ColorIndex = 43 Then ThisWorkbook.Sheets("INVENTAIRE").Range("B14") = ThisWorkbook.Sheets("INVENTAIRE").Range("B14") + 1 If Feuille.Range("M13").Interior.ColorIndex = 43 Then ThisWorkbook.Sheets("INVENTAIRE").Range("B15") = ThisWorkbook.Sheets("INVENTAIRE").Range("B15") + 1 If Feuille.Range("R13").Interior.ColorIndex = 43 Then ThisWorkbook.Sheets("INVENTAIRE").Range("B15") = ThisWorkbook.Sheets("INVENTAIRE").Range("B15") + 1 If Feuille.Range("M14").Interior.ColorIndex = 43 Then ThisWorkbook.Sheets("INVENTAIRE").Range("B16") = ThisWorkbook.Sheets("INVENTAIRE").Range("B16") + 1 If Feuille.Range("R14").Interior.ColorIndex = 43 Then ThisWorkbook.Sheets("INVENTAIRE").Range("B16") = ThisWorkbook.Sheets("INVENTAIRE").Range("B16") + 1 If Feuille.Range("O15").Interior.ColorIndex = 43 Then ThisWorkbook.Sheets("INVENTAIRE").Range("B17") = ThisWorkbook.Sheets("INVENTAIRE").Range("B17") + 1 If Feuille.Range("Q15").Interior.ColorIndex = 43 Then ThisWorkbook.Sheets("INVENTAIRE").Range("B17") = ThisWorkbook.Sheets("INVENTAIRE").Range("B17") + 1 If Feuille.Range("S15").Interior.ColorIndex = 43 Then ThisWorkbook.Sheets("INVENTAIRE").Range("B17") = ThisWorkbook.Sheets("INVENTAIRE").Range("B17") + 1 If Feuille.Range("M16").Interior.ColorIndex = 43 Then ThisWorkbook.Sheets("INVENTAIRE").Range("B18") = ThisWorkbook.Sheets("INVENTAIRE").Range("B18") + 1 If Feuille.Range("R16").Interior.ColorIndex = 43 Then ThisWorkbook.Sheets("INVENTAIRE").Range("B19") = ThisWorkbook.Sheets("INVENTAIRE").Range("B19") + 1 If Feuille.Range("M17").Interior.ColorIndex = 43 Then ThisWorkbook.Sheets("INVENTAIRE").Range("B20") = ThisWorkbook.Sheets("INVENTAIRE").Range("B20") + 1 If Feuille.Range("R17").Interior.ColorIndex = 43 Then ThisWorkbook.Sheets("INVENTAIRE").Range("B21") = ThisWorkbook.Sheets("INVENTAIRE").Range("B21") + 1 If Feuille.Range("O19").Interior.ColorIndex = 43 Then ThisWorkbook.Sheets("INVENTAIRE").Range("B22") = ThisWorkbook.Sheets("INVENTAIRE").Range("B22") + 1 If Feuille.Range("S19").Interior.ColorIndex = 43 Then ThisWorkbook.Sheets("INVENTAIRE").Range("B22") = ThisWorkbook.Sheets("INVENTAIRE").Range("B22") + 1 If Feuille.Range("O20").Interior.ColorIndex = 43 Then ThisWorkbook.Sheets("INVENTAIRE").Range("B22") = ThisWorkbook.Sheets("INVENTAIRE").Range("B22") + 1 If Feuille.Range("S20").Interior.ColorIndex = 43 Then ThisWorkbook.Sheets("INVENTAIRE").Range("B22") = ThisWorkbook.Sheets("INVENTAIRE").Range("B22") + 1 If Feuille.Range("R23").Interior.ColorIndex = 43 Then ThisWorkbook.Sheets("INVENTAIRE").Range("B23") = ThisWorkbook.Sheets("INVENTAIRE").Range("B23") + 1 Next Feuille End Sub

---

Cela fonctionne parfaitement.
Après, je pense qu'un optimisation est possible...:mouarf::mouarf::mouarf:

Merci encore pour ton aide!!!

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27

Sub Calcul() Dim i As Integer Dim TbSce, TbDes   TbSce = Array("O5", "P5", "O6", "Q6", "M7", "M8", "M9", "O10", "P10", "M11", "M12", "R12", "M13") '...etc TbDes = Array("B3", "B4", "B5", "B6", "B7", "B8", "B9", "B10", "B11", "B12", "B13", "B14", "B14") '..etc ThisWorkbook.Sheets("INVENTAIRE").Range("B3:B23").ClearContents For i = 0 To UBound(TbSce) Call SousCalcul(TbSce(i), TbDes(i)) Next i End Sub   Private Sub SousCalcul(ByVal CelSce As String, ByVal CelDes As String) Dim Ws As Worksheet Dim Q As Double   With ThisWorkbook For Each Ws In .Worksheets If Ws.Name <> "INVENTAIRE" Then If Ws.Range(CelSce).Interior.ColorIndex = 43 Then Q = Q + 1 End If Next Ws With .Worksheets("INVENTAIRE").Range(CelDes) .Value = .Value + Q End With End With End Sub

---