Compter les cellules

Question

Bonjour,

Voici mon petit problème. J'essaye de compter des cellules dans la colonne A en fonction de la valeur dans la colonne B.
Plus précisément, voila à quoi ressemble ma feuille:

     A       B
1  100     1
2  100     1
3  100  
4  100     1
5  101     1
6  101
7  101     1
 

Et voila mon code actuel. Il fonctionne très bien pour me retourner le résultat avec la valeur 100.
Mais impossible de faire compter le nombre de valeur 101, 102 etc...lorsque j'ai 1 dans la colonne B.

Sub Macro1()
Thisbook = ActiveWorkbook.Name

i = 1
j =  100
total_a_1 = 0
 
While Workbooks(Thisbook).Sheets("Feuil1").Range("A" & i).Value <> ""
valeur_cellule = Workbooks(Thisbook).Sheets("Feuil1").Range("A" & i).Value
valeur_1 = Workbooks(Thisbook).Sheets("Feuil1").Range("B" & i).Value
 

If valeur_cellule = j And valeur_1 = 1 Then
total_a_1 = total_a_1 + 1
Workbooks(Thisbook).Sheets("Feuil1").Range("C" & 1).Value = total_a_1
End If

i = i + 1

Wend
End Sub

Merci pour vos réponses

Polux31 · Accepted Answer

bonjour,

Ce n'est pas aussi simple que ça.
Il faut stocker dans un tableau les éléments qui correspondent à la condition (col B = 1) et un autre tableau avec 1 élément unique de la colonne A:

Sub Macro1()
Dim lig As Long     'indice pour parcourir les lignes
Dim myTab()         'Tableau de valeur de la colonne A avec 1 dans col B
Dim tabVal()        'Tableau valeur unique
Dim ind As Long     'indice de tableau
Dim indVal As Long  'indice de tableau
Dim ws As Worksheet 'objet worksheet
Dim i As Long       'indice de boucle
Dim j As Long       'indice de boucle
Dim cpt As Long     'compteur de valeur

    'Déclaration de l'objet worksheet
    Set ws = ThisWorkbook.Worksheets("Feuil1")
    'Initialisation de la première ligne à tester
    lig = 2
    'Initialisation des tableaux
    ReDim myTab(ind)
    ReDim tabVal(indVal)
    'Parcours la feuille
    With ws
        While .Range("A" & lig).Value <> ""
            'si le colonne B = 1 Alors on met la valeur de A dans le tableau
            If .Range("B" & lig).Value = 1 Then
                ReDim Preserve myTab(ind)
                myTab(ind) = .Range("A" & lig).Value
                ind = ind + 1
                If doesExist(.Range("A" & lig).Value, tabVal()) = False Then
                    ReDim Preserve tabVal(indVal)
                    tabVal(indVal) = .Range("A" & lig).Value
                    indVal = indVal + 1
                End If
            End If
        'on passe à la ligne suivante
        lig = lig + 1
        Wend
        
    lig = 2
    'On affiche le résultat
    For i = LBound(tabVal()) To UBound(tabVal())
        'initialisation du compteur à zéro
        cpt = 0
        'On compte le nombre de fois l'élément tabVal(j) dans le tableau myTab()
        For j = LBound(myTab()) To UBound(myTab())
            If myTab(j) = tabVal(i) Then cpt = cpt + 1
        Next j
        'on rapporte les valeurs dans la feuille Excel
        .Range("D" & lig).Value = tabVal(i)
        .Range("E" & lig).Value = cpt
        lig = lig + 1
    Next i
    
    End With
    
    'on libère la mémoire et l'objet
    Set ws = Nothing

End Sub

'Fonction qui vérifie que l'on ne met pas 2 fois le même élément dans le tableau
Private Function doesExist(ByVal str As Variant, ByRef mTab()) As Boolean
Dim i As Long

    For i = LBound(mTab()) To UBound(mTab())
        If mTab(i) = str Then
            doesExist = True
            Exit Function
        End If
    Next i
    
    doesExist = False
    
End Function


Voilà

;o)

earvin · Answer

Merci Ploux31
Grâce à ta macro, j'ai réussi à résoudre mon problème.

Compter les cellules

2 réponses

Discussions similaires

Newsletters