Bonjour @fanfan38Bonjour
Je ne vois pas de quantité dans ton tableau
Ci joint ma proposition
A+ François
Bonjour @JHABonjour à tous,
Avec Power Query et une concatenation
JHA
Bonjour @danielcoBonjour à tous,
Un essai avec deux formules (en jaune).
Daniel
Sub Unique()
Dim d As Object, i&, x$
Set d = CreateObject("Scripting.Dictionary")
With [A1].CurrentRegion.Resize(, 9)
ReDim resu(1 To .Rows.Count, 1 To 1)
resu(1, 1) = "Quantité"
For i = 2 To .Rows.Count
x = .Cells(i, 1) & .Cells(i, 6) & .Cells(i, 8)
If x <> "" And Not d.exists(x) Then d(x) = i
resu(d(x), 1) = resu(d(x), 1) + 1
Next
.AutoFilter
.Columns(9) = resu
.AutoFilter 9, ">0"
End With
End Sub
Bonjour @job75Bonjour à tous,
Une solution VBA avec le filtre automatique :
A+VB:Sub Unique() Dim d As Object, i&, x$ Set d = CreateObject("Scripting.Dictionary") With [A1].CurrentRegion.Resize(, 9) ReDim resu(1 To .Rows.Count, 1 To 1) resu(1, 1) = "Quantité" For i = 2 To .Rows.Count x = .Cells(i, 1) & .Cells(i, 6) & .Cells(i, 8) If x <> "" And Not d.exists(x) Then d(x) = i resu(d(x), 1) = resu(d(x), 1) + 1 Next .AutoFilter .Columns(9) = resu .AutoFilter 9, ">0" End With End Sub
Bonjour @CousinhubBonjour,
Une solution à base de Power Query (plus un code VBA pour actualiser).
Dans l'onglet "Base", ta base de données sous forme de Tableau Structuré, et nommé "T_Data"
Dans l'onglet "Recap", à gauche, tous les titres de ta base de données en colonne A (à bien renseigner - un Copier/Coller, recopie "Transposée", pour avoir une concordance exacte des titres)
En colonne B, tu choisis les filtres (données) dont tu veux calculer les types de manière unique (une validation des données te permet de choisir le X)
Le bouton "Actualiser"
Et le Tableau "T_Final", qui te donne les nombres uniques selon tes choix...
Bon dimanche
Pour adapter il suffit en effet de modifier les positions des colonnes :Par contre si je veux adapter l'emplacement de mes colonnes ou ajouter un autre filtre que faut-il adapter dans le code.
Sub Unique()
Dim d As Object, i&, x$
Set d = CreateObject("Scripting.Dictionary")
With [A1].CurrentRegion.Resize(, 30)
ReDim resu(1 To .Rows.Count, 1 To 1)
resu(1, 1) = "Quantité"
For i = 2 To .Rows.Count
x = .Cells(i, 6) & .Cells(i, 16) & .Cells(i, 18)
If x <> "" And Not d.exists(x) Then d(x) = i
resu(d(x), 1) = resu(d(x), 1) + 1
Next
.AutoFilter
.Columns(30) = resu
.AutoFilter 30, ">0"
End With
End Sub
Pourquoi une option ? La macro crée un filtre sur le tableau, un point c'et tout.Il manque l'option "ajouter un filtre", non?
Bonjour @job75Pour adapter il suffit en effet de modifier les positions des colonnes :
VB:Sub Unique() Dim d As Object, i&, x$ Set d = CreateObject("Scripting.Dictionary") With [A1].CurrentRegion.Resize(, 30) ReDim resu(1 To .Rows.Count, 1 To 1) resu(1, 1) = "Quantité" For i = 2 To .Rows.Count x = .Cells(i, 6) & .Cells(i, 16) & .Cells(i, 18) If x <> "" And Not d.exists(x) Then d(x) = i resu(d(x), 1) = resu(d(x), 1) + 1 Next .AutoFilter .Columns(30) = resu .AutoFilter 30, ">0" End With End Sub