Compter une cellule dans tout un classeur

**Hilsen** · 05/10/2011, 21h41

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**SfJ5Rpw8** · 05/10/2011, 21h54

bonsoir,

à quoi sert ton For i = 3 To 23 ?

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 ActiveWorkbook.Worksheets

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 ThisWorkbook.Worksheets

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

Le select ne sert à rien .. :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

elle sont ou tes cellules oui ? ligne / Colonne ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

..

**Hilsen** · 05/10/2011, 22h41

Mieux vaut des images que de long discours:

**SfJ5Rpw8** · 05/10/2011, 22h45

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**Hilsen** · 05/10/2011, 22h49

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

Voila ce que cela donne:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**SfJ5Rpw8** · 05/10/2011, 23h01

Je croyais le tableau mieux organisé...

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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** · 06/10/2011, 11h36

Voilà mon code final:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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** · 06/10/2011, 16h08

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

Compter une cellule dans tout un classeur

Macros et VBA Excel

Discussions similaires

Partager

Partager