Extraction, suppression des doublons et tri
Re
Alors j’ai du mal m’exprimer. En fait c’est pourvoir selectionner un choix 3 après avoir sélectionner le choix 1 sans affiner avec un choix 2.
Je suis en train de m’atteler à réfléchir comment compéter la première partie du code pour extraire en même temps les réf mais je pense voir comment faire :-). Je te redis ce que je fais. Si ça marche, c’est nikel, sinon on en reparle.
Re re :-)
Je pense que j'ai trouvé. Enfin ça semble fonctionner pour le moment.
En gros, j'ai mis une condition supplémentaire sur le second Elseif de ma macro Worksheet_SelectionChange (qui traite la sélection de Choix_ref_1) pour que celui-ci ne s'active que si Choix_Type_1 a été rempli et j'ai ajouté une macro Worksheet_Change qui ne s'active que si Choix_ref_1 est modifié et si Choix_Company_1 est différent de la valeur par défaut en lui appliquant un critère sur le type de compagnie sélection au préalable
De cette façon, je peux générer, je peux sélectionner une référence après avoir sélectionné une compagnie et si a posteriori, je sélectionne un type de produit, cela remet à zéro les ref et régénère la liste correspondant a la compagnie et au type.
Après c'est peut être optimisable...
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim dico As Object
Dim data() As Variant
Dim i As Integer
Dim tbl As Variant
Dim critere1 As String
Dim critere2 As String
Dim critere3 As String
If Not Intersect(Target, Range("Choix_Company_1")) Is Nothing Then
'Choix_Company_1
data = Sheets("Database").Range("Tableau1[[Company]:[Reference]]").Value
Set dico = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(data)
dico(data(i, 1)) = ""
Next
tbl = dico.Keys
QuickSort tbl
If dico.Count > 0 Then
With Sheets("construction")
If Not .ListObjects("Tableau2").DataBodyRange Is Nothing Then .ListObjects("Tableau2").DataBodyRange.Delete
Sheets("home").Range("Choix_Company_1") = Sheets("construction").Range("AC3").Value
Sheets("home").Range("Choix_Type_1") = Sheets("construction").Range("AC4").Value
Sheets("home").Range("Choix_Ref_1") = Sheets("construction").Range("AC5").Value
On Error Resume Next
'.Range("B5").Resize(UBound(tbl) + 1, 1) = Application.Transpose(tbl)
.Range("B5").Resize(UBound(tbl) - LBound(tbl) + 1, 1) = Application.Transpose(tbl)
On Error GoTo 0
End With
End If
ElseIf Not Intersect(Target, Range("Choix_Type_1")) Is Nothing Then
'Choix_Type_1
data = Sheets("Database").Range("Tableau1[[Company]:[Reference]]").Value
critere1 = Sheets("Home").Range("Choix_Company_1").Value
Set dico = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(data)
If data(i, 1) = critere1 Then dico(data(i, 2)) = ""
Next
tbl = dico.Keys
QuickSort tbl
If dico.Count > 0 Then
With Sheets("construction")
If Not .ListObjects("Tableau3").DataBodyRange Is Nothing Then .ListObjects("Tableau3").DataBodyRange.Delete
Sheets("home").Range("Choix_Type_1") = Sheets("construction").Range("AC4").Value
Sheets("home").Range("Choix_Ref_1") = Sheets("construction").Range("AC5").Value
On Error Resume Next
' .Range("D5").Resize(UBound(tbl) + 1, 1) = Application.Transpose(tbl)
.Range("D5").Resize(UBound(tbl) - LBound(tbl) + 1, 1) = Application.Transpose(tbl)
On Error GoTo 0
End With
End If
ElseIf Not Intersect(Target, Range("Choix_Ref_1")) Is Nothing And Sheets("home").Range("Choix_Type_1").Value <> Sheets("construction").Range("AC4").Value Then
'Choix_Ref_1
data = Sheets("Database").Range("Tableau1[[Company]:[Reference]]").Value
critere1 = Sheets("Home").Range("Choix_Company_1").Value
critere2 = Sheets("Home").Range("Choix_Type_1").Value
Set dico = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(data)
If data(i, 1) = critere1 And data(i, 2) = critere2 Then dico(data(i, 3)) = ""
Next
tbl = dico.Keys
QuickSort tbl
If dico.Count > 0 Then
With Sheets("construction")
If Not .ListObjects("Tableau3").DataBodyRange Is Nothing Then .ListObjects("Tableau3").DataBodyRange.Delete
Sheets("home").Range("Choix_Ref_1") = Sheets("construction").Range("AC5").Value
On Error Resume Next
' .Range("F5").Resize(UBound(tbl) + 1, 1) = Application.Transpose(tbl)
.Range("F5").Resize(UBound(tbl) - LBound(tbl) + 1, 1) = Application.Transpose(tbl)
On Error GoTo 0
End With
End If
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim dico As Object
Dim data() As Variant
Dim i As Integer
Dim tbl As Variant
Dim critere1 As String
If Not Intersect(Target, Range("Choix_Company_1")) Is Nothing And Sheets("home").Range("Choix_Company_1").Value <> Sheets("construction").Range("AC3").Value Then
data = Sheets("Database").Range("Tableau1[[Company]:[Reference]]").Value
critere1 = Sheets("Home").Range("Choix_Company_1").Value
Set dico = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(data)
If data(i, 1) = critere1 Then dico(data(i, 3)) = ""
Next
tbl = dico.Keys
QuickSort tbl
If dico.Count > 0 Then
With Sheets("construction")
If Not .ListObjects("Tableau3").DataBodyRange Is Nothing Then .ListObjects("Tableau3").DataBodyRange.Delete
Sheets("home").Range("Choix_Ref_1") = Sheets("construction").Range("AC5").Value
On Error Resume Next
' .Range("F5").Resize(UBound(tbl) + 1, 1) = Application.Transpose(tbl)
.Range("F5").Resize(UBound(tbl) - LBound(tbl) + 1, 1) = Application.Transpose(tbl)
On Error GoTo 0
End With
End If
End If
End Sub- Messages
- 1'026
- Excel
- 2016 FR // 365
- Inscrit
- 19/04/2019
- Emploi
- Étudiant en 5e année d'école d'Ingénieur
Salut,
Par trois fois tu as fait cette petite erreur, sans grand impact mais code optimisable donc ;)
Code corrigé :
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim dico As Object
Dim data() As Variant, tbl As Variant
Dim i As Integer
Dim critere1 As String, critere2 As String, critere3 As String
If Not Intersect(Target, Range("Choix_Company_1")) Is Nothing Then
'Choix_Company_1
data = Sheets("Database").Range("Tableau1[[Company]:[Reference]]").Value
Set dico = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(data)
dico(data(i, 1)) = ""
Next
tbl = dico.Keys
QuickSort tbl
If dico.Count > 0 Then
With Sheets("construction")
If Not .ListObjects("Tableau2").DataBodyRange Is Nothing Then .ListObjects("Tableau2").DataBodyRange.Delete
Sheets("home").Range("Choix_Company_1") = .Range("AC3").Value
Sheets("home").Range("Choix_Type_1") = .Range("AC4").Value
Sheets("home").Range("Choix_Ref_1") = .Range("AC5").Value
On Error Resume Next
'.Range("B5").Resize(UBound(tbl) + 1, 1) = Application.Transpose(tbl)
.Range("B5").Resize(UBound(tbl) - LBound(tbl) + 1, 1) = Application.Transpose(tbl)
On Error GoTo 0
End With
End If
ElseIf Not Intersect(Target, Range("Choix_Type_1")) Is Nothing Then
'Choix_Type_1
data = Sheets("Database").Range("Tableau1[[Company]:[Reference]]").Value
critere1 = Sheets("Home").Range("Choix_Company_1").Value
Set dico = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(data)
If data(i, 1) = critere1 Then dico(data(i, 2)) = ""
Next
tbl = dico.Keys
QuickSort tbl
If dico.Count > 0 Then
With Sheets("construction")
If Not .ListObjects("Tableau3").DataBodyRange Is Nothing Then .ListObjects("Tableau3").DataBodyRange.Delete
Sheets("home").Range("Choix_Type_1") = .Range("AC4").Value
Sheets("home").Range("Choix_Ref_1") = .Range("AC5").Value
On Error Resume Next
' .Range("D5").Resize(UBound(tbl) + 1, 1) = Application.Transpose(tbl)
.Range("D5").Resize(UBound(tbl) - LBound(tbl) + 1, 1) = Application.Transpose(tbl)
On Error GoTo 0
End With
End If
ElseIf Not Intersect(Target, Range("Choix_Ref_1")) Is Nothing And Sheets("home").Range("Choix_Type_1").Value <> Sheets("construction").Range("AC4").Value Then
'Choix_Ref_1
data = Sheets("Database").Range("Tableau1[[Company]:[Reference]]").Value
critere1 = Sheets("Home").Range("Choix_Company_1").Value
critere2 = Sheets("Home").Range("Choix_Type_1").Value
Set dico = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(data)
If data(i, 1) = critere1 And data(i, 2) = critere2 Then dico(data(i, 3)) = ""
Next
tbl = dico.Keys
QuickSort tbl
If dico.Count > 0 Then
With Sheets("construction")
If Not .ListObjects("Tableau3").DataBodyRange Is Nothing Then .ListObjects("Tableau3").DataBodyRange.Delete
Sheets("home").Range("Choix_Ref_1") = .Range("AC5").Value
On Error Resume Next
' .Range("F5").Resize(UBound(tbl) + 1, 1) = Application.Transpose(tbl)
.Range("F5").Resize(UBound(tbl) - LBound(tbl) + 1, 1) = Application.Transpose(tbl)
On Error GoTo 0
End With
End If
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim dico As Object
Dim data() As Variant, tbl As Variant
Dim i As Integer
Dim critere1 As String
If Not Intersect(Target, Range("Choix_Company_1")) Is Nothing And Sheets("home").Range("Choix_Company_1").Value <> Sheets("construction").Range("AC3").Value Then
data = Sheets("Database").Range("Tableau1[[Company]:[Reference]]").Value
critere1 = Sheets("Home").Range("Choix_Company_1").Value
Set dico = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(data)
If data(i, 1) = critere1 Then dico(data(i, 3)) = ""
Next
tbl = dico.Keys
QuickSort tbl
If dico.Count > 0 Then
With Sheets("construction")
If Not .ListObjects("Tableau3").DataBodyRange Is Nothing Then .ListObjects("Tableau3").DataBodyRange.Delete
Sheets("home").Range("Choix_Ref_1") = .Range("AC5").Value
On Error Resume Next
' .Range("F5").Resize(UBound(tbl) + 1, 1) = Application.Transpose(tbl)
.Range("F5").Resize(UBound(tbl) - LBound(tbl) + 1, 1) = Application.Transpose(tbl)
On Error GoTo 0
End With
End If
End If
End Subha oui exact :-)
merci
Hello
Question complémentaire.
Je ne suis pas sûr d'avoir compris le sens de On Error Resume Nextet de On Error GoTo 0
Dans ma tête, ça permettait, entre le With et le End with de passer si il y avait une erreur mais du coup:
- Quel est la différence entre les deux au final et quel est leur fonction?
- Est ce que j'avais bien compris leur fonction ou bien suis-je a coté de la plaque?
- Dans quel cas utiliser l'un ou l'autre?
Bonne semaine a tous
Le On Error Resume Next permet de passer l'instruction au cas où tbl serait vide !
Le On Error GoTo 0 rétablit la situation normale, de façon à ce que, s'il y avait une erreur ultérieure sur autre partie du code, elle soit détectée.
Merci pour l’explication :-)
Hello a vous deux et bonne année.
J'ai bien avancé dans mon doc et sa réalisation.
J'ai une incertitude sur le fonctionnement des dico que nous avons longuement évoqué ici.
Dans ce cas particulier, on utilise le dico pour générer une "liste de mots" sans "définition" associée et ensuite faire un tri/suppression des doublons pour obtenir une liste.
En dehors de cet usage spécifique du Dico, de manière générale, en quoi consiste la "définition" associée à un "mots". Est-ce que cela pourrait me permettre de reporter les valeurs associées à la référence sélectionnée dans la liste déroulante en C12 dans le tableau en dessous. À l'heure actuelle, "l'extraction" de ces valeurs est régie par une formule de type Index/Equiv.
J'espère que ce n'est pas trop confus
Bonne soirée
bastien
En dehors de cet usage spécifique du Dico, de manière générale, en quoi consiste la "définition" associée à un "mots".
C'est là où cela devient intéressant et où on peut faire preuve de créativité :
- on peut y faire un compteur d'occurrence avec
dico(chose)=dico(chose)+1 - on peut y mettre une adresse pour ensuite éviter de faire des find séquentiels très chronophages
- s'il y a plusieurs occurrences, on peut faire des listes d'adresses par exemple séparées par
|que l'on va splitter pour obtenir un tableau ... cela permet d'éviter des find sur plusieurs occurrences avec des codes un poil alambiqués - etc.
Hello
Merci pour ce complément d'info qui semble m'ouvrir des portes intéressantes.
tu parles de :
s'il y a plusieurs occurrences, on peut faire des listes d'adresses par exemple séparées par | que l'on va splitter pour obtenir un tableau ... cela permet d'éviter des find sur plusieurs occurrences avec des codes un poil alambiqués
Si j'interprète bien ce que tu as écrit, j'imagine que cette approche pourrait me permettre de remplir mon tableau avec les différents paramètres correspondant à la ref sélectionnée référence avec les différents paramètres de cette référence. Je remets le document
Comme je disais, à l'heure actuelle, c'est une formule Index/Equiv qui fait ça, mais cela me bloque en quelque sorte pour avancer sur une autre partie de mon fichier.
En fait, on m'a demandé de rendre la base de donnée difficilement exploitable par un utilisateur curieux. Au-delà du fait de masquer la feuille (very hidden), j'ai pensé que je pourrais crypter le contenu de la base de données et lever le cryptage lorsque les macros ont besoin d'accéder à la base de données puis le remettre ensuite (pour généré la liste compagny, puis type puis ref).
J'ai fait quelques tests de cryptage/décryptage et celui-ci se fait assez rapidement (je peux t'envoyer la macro si ça t'intéresse).
Le seul hic c'est que si je recrypte la base de donné après sélection de la ref, les valeurs reportées dans le tableau en dessous via la formule Index/Equiv seront les valeurs cryptée.... C'est pour cela que j'aimerais pouvoir reporter les valeurs via une macro avant de recypter la base de données.
Comme je n'ai jamais testé ce type d'approche, je n'arrive pas à évaluer si le repport des données via une macro en utilisant un dico (si cela est bien sûr faisable comme ça) va impacter le temps d'exécution du programme, car la avec les formules c'est quasi immédiat.
Pour tester, je suppose qu'il faudrait générer un dictionnaire avec un seul "mot", la référence sélectionnée et sa "définition" correspondant aux valeurs à reporter séparé par un |. Mes connaissances des dico et de leur usage étant très très limité (c'est vous qui m'avez appris tout ce que je sais au travers de ce flux de discussion), je ne sais pas du tout comme attaquer le truc et coder ce rempart de donnée via l'usage d'un dico. Pourriez-vous m'aider svp?
Par ailleurs, je ne suis pas sûr de comprendre comment marche le compteur d'occurrence avec dico. On parle bien de compter le nombre de mots ou de lettres ou de chiffres dans une expression? C'est plus pour ma connaissance générale, car dans ce cas particulier, je ne suis pas sûr que ça me serve, mais on sait jamais, un jour.
Merci par avance
Bastien
ps : j'en ai encore écrit tout une tartine ... :-( dsl
ps : j'en ai encore écrit tout une tartine ... :-( dsl
cela se lit très bien
un exemple, ou plutôt 4 !
Sub listeTriée()
Dim Data, dico As Object
Debug.Print "Liste Triée .............."
Data = Sheets(1).ListObjects(1).DataBodyRange
Set dico = CreateObject("Scripting.Dictionary")
' mémorisation des valeurs sous forme de dictionnaire
For i = 1 To UBound(Data)
dico(Data(i, 1)) = ""
Next
' transfert dans un tableau des clés pour tri
Tbl = dico.keys
QuickSort Tbl
' rechargement du dictionnaire avec clés triées et application des valeurs
dico.RemoveAll
For i = LBound(Tbl) To UBound(Tbl)
dico(Tbl(i)) = 1
Next i
' lecture des clés et valeurs
For Each Cle In dico.keys
Debug.Print Cle
Next
End Sub
Sub Compteur()
Dim Data, dico As Object
Debug.Print "Compteur .............."
Data = Sheets(1).ListObjects(1).DataBodyRange
Set dico = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Data)
dico(Data(i, 1)) = dico(Data(i, 1)) + 1
Next
For Each Cle In dico.keys
Debug.Print Cle, "Nombre de matières :", dico(Cle)
Next
End Sub
Sub listeAdresses()
Dim dico As Object
Debug.Print "Adresses .............."
Set dico = CreateObject("Scripting.Dictionary")
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
' /!\ value est ici indispensable = piège /!\
dico(Cells(i, 1).Value) = dico(Cells(i, 1).Value) & "|" & Cells(i, 1).Address
Next
For Each Cle In dico.keys
Debug.Print Cle, "adresses :", dico(Cle)
Next
' il suffit ensuite de faire un split sur Dico(Cle)
End Sub
Sub listeMatières()
Dim Data, dico As Object
Debug.Print "Liste le contenu de chaque item .............."
Data = Sheets(1).ListObjects(1).DataBodyRange
Set dico = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Data)
dico(Data(i, 1)) = dico(Data(i, 1)) & "|" & Data(i, 2)
Next
For Each Cle In dico.keys
Debug.Print Cle, "Liste des matières :", dico(Cle)
Next
' il suffit ensuite de faire un split sur Dico(Cle)
End SubHello
Bon, alors on va y aller par étape.
Je suis en train d'essayer d'adapter tout ce que tu m'as donné comme outil (et potentiel) a mon cas.
1) je ne suis pas sur de comprendre ce que représente "faire un split sur Dico(cle)" et ce que ça va générer derrière en termes de résultat
2) J'ai reussi a adapter ton code listeMatières() pour qu'il fasse un dico sur une ligne. (je sais ça peut paraitre facile comme ça mais j'ai galerer :-( ). J'ai au préalable simplié ton tableau pour qu'il n'y ait qu'une seule fois le prénom, car dans mon cas, je n'aurais qu'une seul fois la ref (puisque la ref est unique dans la bdd).
Sub listeMatières()
Dim Data, dico As Object
Dim i As Integer
Debug.Print "Liste le contenu de chaque item .............."
Data = Sheets("feuil1").Range("A3", Range("A3").End(xlToRight))
Set dico = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Data)
dico(Data(i, 1)) = dico(Data(i, 1)) & "|" & Data(i, 2) & "|" & Data(i, 3) & "|" & Data(i, 4)
Next
For Each Cle In dico.keys
Debug.Print Cle, "Liste des matières :", dico(Cle)
Next
' il suffit ensuite de faire un split sur Dico(Cle)
End Subet voici le résultat obtenu
Liste le contenu de chaque item ..............
Jules Liste des matières : |hist-géo|19|wcvn
Cela me permettrait in fini de faire un dico sur la ligne de la ref sélectionnée par l'utilisateur avec en clé la ref et ensuite les paramètres associer a la ref. Par contre, je ne vois toujours pas comment le reporter dans une plage sur une feuille (je suppose en le transformant avant en tableau).
Est-ce qu'il serait possible de coder la création du dico de tel façon qu'il ajoute les data jusqu'à la fin de la ligne. Ici, c'est simple car y a que 4 lignes, mais quand y en aura 10 ou 20.... Je ne vois pas comment faire si c'est faisable.
3) Dans ce code, le range est basé sur A3 mais dans mon code final il faudra que le range commence dans ma base de données a la cellule correspondante a la ref sélectionnée.
Je pense qu'il va falloir utiliser le code Sub listeAdresses() pour créer un dico des adresses correspondant aux ref de la bdd. Ensuite, il va falloir faire une recherche de correspondance entre la ref sélectionnée par l'usager dans la liste déroulante (elle-même générée par un dico, grave a toi d'ailleurs ;-) ) et la liste dans le dico et récupérer sa coordonnée dans la bdd. Ensuite en stockant cette coordonnée dans une variable, on pourrait reporter cette variable dans le range du code ci-dessus à la place de A3. Mais la, je sais même pas par quoi commencer.
J'espère que mes explications sont claires et que je ne pars pas trop dans tous les sens.
Bonne fin de journée
Bastien
Là, c'est moi qui commence à être perdu ... notamment sur ton objectif.
Mais pour répondre sur la "technique"
For i = 1 To UBound(Data) dico(Data(i, 1)) = dico(Data(i, 1)) & "|" & Data(i, 2) & "|" & Data(i, 3) & "|" & Data(i, 4) NextEst-ce qu'il serait possible de coder la création du dico de tel façon qu'il ajoute les data jusqu'à la fin de la ligne. Ici, c'est simple car y a que 4 lignes, mais quand y en aura 10 ou 20.... Je ne vois pas comment faire si c'est faisable.
fais une boucle sur le second paramètre
For i = 1 To UBound(Data)
for j= 2 to Ubound(tbl,2)
dico(Data(i, 1)) = dico(Data(i, 1)) & "|" & Data(i, j)
next
Next3) Dans ce code, le range est basé sur A3 mais dans mon code final il faudra que le range commence dans ma base de données a la cellule correspondante a la ref sélectionnée.
si tu traites une seule référence, dans ce cas fais directement un find pour trouver la ligne concernée par la référence
Hello
Basé sur ta remarque,
Là, c'est moi qui commence à être perdu ... notamment sur ton objectif.
Je me suis posé , j'ai réfléchit plusieur jour en tournant le truc dans tous les sens et tu as raison, je faisait fausse route et me complexifiait la vie pour rien.
Cependant, nos recents échanges m'ont faire découvrir de nouveaux horizons et possibilité avec dico. Merci :-).