A voir également:
- Compter les cellules
- Protéger des cellules excel - Guide
- Excel compter les cellules de couleur - Guide
- Impossible de fusionner des cellules excel ✓ - Forum Excel
- Je ne peux pas fusionner les cellules sur excel - Forum Bureautique
- Figer des cellules excel - Guide
2 réponses
Polux31
Messages postés
6917
Date d'inscription
mardi 25 septembre 2007
Statut
Membre
Dernière intervention
1 novembre 2016
1 197
10 mars 2010 à 23:12
10 mars 2010 à 23:12
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:
Voilà
;o)
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)