Lister valeurs unique d'une bdd en VBA
Bonsoir,
Je travaille régulièrement avec un fichier Excel qui comporte une liste d'articles (des cylindres de serrures) avec des quantités/types/dimensions/Nb de clé différents.
Je dois très souvent "résumer" ces tableaux/listes dans un mail et en les regroupant par type de cylindre et dimensions identiques.
Quand le tableau est petit, j'utilise les filtres et je le fais à la mano.
Quand le tableau est plus important, j'utilise un TCD.
Mais comme je souhaite apprendre le VBA, je voudrais essayer de faire cette action répétitive et parfois fastidieuse via un code VBA (et non des formules).
Voici un fichier qui résume ce que j'ai et ce que je veux :
En gros je souhaite un résultat de la forme :
W pièce(s) du type de cylindre A en dimensions L1xL1
X pièce(s) du type de cylindre A en dimensions L2xL2
Y pièce(s) du type de cylindre B en dimensions L1xL1
Z pièce(s) de clés au total
Merci d'avance pour votre aide,
Vip4rk
Bonjour
Une solution PowerQuery (intégré à 2016)
Mise à jour par Données, Actualiser tout
Bonsoir @78chris,
Merci pour ton aide, c'est effectivement une solution intéressante.
D'autant que j'ai souvent entendu parler de PowerQuery sans jamais encore l'avoir utilisé.
Je vais la potasser par curiosité intellectuelle.
Toutefois je suis quand même preneur d'un code vba faisant la même chose
Vip4rk
Hello @Boisgontierjacques
Merci pour l'aide mais je sais déjà le faire avec des formules et je cherche plutôt un code VBA pour me permettre d'aller encore plus loin dans l'optimisation de ce que je pourrai faire (car ça sera encore un peu plus complexe que ce que j'ai énoncé).
De plus mon objectif est vraiment de progresser en VBA.
Mais je vais déjà essayer de produire un bout de code moi-même et je vous le soumettrai par la suite.
Vip4rk
>je cherche plutôt un code VBA
Une fonction personnalisée est écrite en VBA.
Elle a l'avantage d'être réutilisable.
Boisgontier
@Boisgontierjacques
Oui c'est vrai
Vip4rk
Pour l'instant j'arrive déjà à trouver la liste des types de cylindres différents et à l'écrire dans un nouvel onglet.
Option Explicit
'
Sub Article_List()
'
Application.ScreenUpdating = False
'
Dim MonDico
Dim Table_Unique_Article
Dim i As Long
'
'Je définis les valeurs unique des types d'articles (cylindres) en colonne H
Set MonDico = CreateObject("Scripting.Dictionary")
Table_Unique_Article = Worksheets("Plan").Range("H17:H" & [H65000].End(xlUp).Row)
For i = LBound(Table_Unique_Article) To UBound(Table_Unique_Article)
MonDico(Table_Unique_Article(i, 1)) = ""
Next i
'
'Je créé un nouvel onglet
Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Article_List"
'Je colle le résultat dans ce nouvel onglet
Worksheets("Article_List").Range("A1").Resize(MonDico.Count, 1) = Application.Transpose(MonDico.keys)
'
Application.ScreenUpdating = False
'
End Sub
Step 2 : j'essaye d'intégrer le deuxième paramètre à prendre en compte dans ma liste d'articles : les dimensions des cylindres.
Pas simple!
Vip4rk
Sous forme de SUB
Option Compare Text
Sub compte()
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare
temp = [B4:D10].Value
nbCol = UBound(temp, 2)
For i = 1 To UBound(temp)
tmp = ""
For k = 1 To nbCol
tmp = tmp & temp(i, k) & "|"
Next k
If temp(i, 1) <> "" Then d(tmp) = d(tmp) + 1
Next i
ReDim b(1 To d.Count, 1 To nbCol + 1)
i = 0
For Each c In d.keys
i = i + 1
a = Split(c, "|")
For k = 1 To nbCol
b(i, k) = a(k - 1)
Next k
b(i, k) = d(c)
Next
[G4].Resize(d.Count, nbCol + 1) = b
End Sub
Boisgontier
Merci Boisgonthier pour ta réponse.
J'ai bien regardé ton code et c'est intéressant.
Mais entre temps j'ai aussi pas mal avancé sur le mien :
Option Explicit
'
Sub Article_List()
'
Application.ScreenUpdating = False
'
Dim d
Dim Table_Keyplan
Dim i As Long
Dim clé
Dim lig
'
'Je définis les valeurs unique des types d'articles (cylindres) en colonne H
Set d = CreateObject("Scripting.Dictionary")
Table_Keyplan = Worksheets("Plan").Range("H17:M" & [M65000].End(xlUp).Row)
'
Dim Table_Article_List(): ReDim Table_Article_List(1 To UBound(Table_Keyplan), 1 To UBound(Table_Keyplan))
'
For i = LBound(Table_Keyplan) To UBound(Table_Keyplan)
'
clé = Table_Keyplan(i, 1) & "|" & Table_Keyplan(i, 6) ' Clé multi-colonnes
'
If d.exists(clé) Then
lig = d(clé) ' Récupération index Table_Article_List()
Else
d(clé) = d.Count + 1: lig = d.Count: Table_Article_List(lig, 1) = Table_Keyplan(i, 1): Table_Article_List(lig, 2) = Table_Keyplan(i, 6) ' Nouvelle clé
End If
'
Next i
'
'Je créé un nouvel onglet
Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Article_List"
'Je colle le résultat dans ce nouvel onglet
Worksheets("Article_List").Range("A1").Resize(d.Count, UBound(Table_Article_List)) = Table_Article_List
'
Application.ScreenUpdating = True
'
End Sub
Le résultat est pas mal : j'obtiens bien la liste de type de cylindre unique par dimensions extérieures unique.
Step 3 : intégrer le 3ème critère, la dimension intérieure...
J'avance pas à pas!
Vip4rk
Pour info voici mon fichier de travail :
Vip4rk
J'ai bien réussi l'étape 3 (oui je spam et oui je me réponds tout seul mais c'est au cas ou quelqu'un essaye de m'aider pour ne pas lui faire perdre son temps).
Step 4 : je dois sommer les quantités d’occurrences identiques en sommant les quantités inscrites en colonne G.
Vip4rk
Ca y est je sèche.. Mon total de cylindre par type et dimensions ne s'affiche pas ou je veux!
Option Explicit
'
Sub Article_List()
'
Application.ScreenUpdating = False
'
Dim d
Dim Table_Keyplan
Dim i As Long
Dim clé
Dim lig
Dim c
'
Set d = CreateObject("Scripting.Dictionary")
Table_Keyplan = Worksheets("Plan").Range("G17:N" & [N65000].End(xlUp).Row)
'
Dim Table_Article_List(): ReDim Table_Article_List(1 To UBound(Table_Keyplan), 1 To UBound(Table_Keyplan))
'
For i = LBound(Table_Keyplan) To UBound(Table_Keyplan)
'
clé = Table_Keyplan(i, 2) & "|" & Table_Keyplan(i, 6) & "|" & Table_Keyplan(i, 7) ' Clé multi-colonnes
'
If d.exists(clé) Then
lig = d(clé) ' Récupération index Table_Article_List()
Else
d(clé) = d.Count + 1: lig = d.Count: Table_Article_List(lig, 1) = Table_Keyplan(i, 2): Table_Article_List(lig, 2) = Table_Keyplan(i, 6): Table_Article_List(lig, 3) = Table_Keyplan(i, 7) ' Nouvelle clé
End If
'
For c = 1 To UBound(Table_Keyplan): Table_Article_List(lig, c) = Table_Article_List(lig, c) + Table_Keyplan(i, c): Next c ' On somme les qté de cylindres par type et dimensions uniques
'
Next i
'
'Je crée un nouvel onglet
Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Article_List"
'Je colle le résultat dans ce nouvel onglet
Worksheets("Article_List").Range("A1").Resize(d.Count, UBound(Table_Article_List)) = Table_Article_List
'
Application.ScreenUpdating = True
'
End Sub
Le fichier :
Vip4rk
J'ai réussi
Pour info si un jour ça intéresse qqun :
Option Explicit
'
Sub Article_List()
'
Application.ScreenUpdating = False
'
Dim d
Dim Table_Keyplan
Dim i As Long
Dim clé
Dim lig
Dim c As Long
'
Set d = CreateObject("Scripting.Dictionary")
Table_Keyplan = Worksheets("Plan").Range("G17:N" & [N65000].End(xlUp).Row)
'
Dim Table_Article_List(): ReDim Table_Article_List(1 To UBound(Table_Keyplan), 1 To UBound(Table_Keyplan, 2))
'
For i = LBound(Table_Keyplan) To UBound(Table_Keyplan)
'
clé = Table_Keyplan(i, 2) & "|" & Table_Keyplan(i, 6) & "|" & Table_Keyplan(i, 7) ' Clé multi-colonnes
'
If d.exists(clé) Then
lig = d(clé) ' Récupération index Table_Article_List()
Else
d(clé) = d.Count + 1: lig = d.Count: Table_Article_List(lig, 1) = Table_Keyplan(i, 2): Table_Article_List(lig, 2) = Table_Keyplan(i, 6): Table_Article_List(lig, 3) = Table_Keyplan(i, 7) ' Nouvelle clé
End If
'
Table_Article_List(lig, 4) = Table_Article_List(lig, 4) + Table_Keyplan(i, 1) ' On somme les qté de cylindres par type et dimensions uniques
'
Next i
'
Range("A22").Resize(d.Count, UBound(Table_Article_List)) = Table_Article_List
'
Application.ScreenUpdating = True
'
End Sub
Vip4rk