Compter une cellule dans tout un classeur [Résolu]

[Hilsen]

Bonsoir Messieurs/dames!

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

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...)

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

[bbil]

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...

..

[Hilsen]

Mieux vaut des images que de long discours:

[bbil]

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...

[Hilsen]

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...

[bbil]

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

[Hilsen]

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...

Merci encore pour ton aide!!!

[mercatog]

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