XL 2013 Aide sur Dictionary : recherche et restitution

erics83 · 29 Janvier 2022

Bonjour,

J'essaye de comprendre l'utilisation de Dictionary (merci à JB et ses tutos qui montrent à quel point cette solution est très très rapide).

La recherche par clef est vraiment super rapide, mais je n'arrive pas à restituer :

dans mon classeur test, admettons que je veuille inscrire en Feuil3 le résultat d'une recherche dans la Feuille "BD", la recherche étant : Ville 7, pour Ami217 et avec un niveau <4, d'après ce que j'ai pu comprendre, il faut créer une clef style "Ville7|Ami217|", là où je bloque c'est comment rajouter à la clef le niveau inférieur à 4, et surtout comment restituer dans Feuil3 les résultats....
Jusqu'à présent je faisais une boucle "For I", mais j'ai un classeur avec 60000 lignes et 30 colonnes et...ça prend beaucoup de temps....d'où l'idée de passer par Dictionary (et en plus, c'est pour comprendre comment bien l'utiliser...)

Merci pour votre aide,

Robert · 29 Janvier 2022

Bonjour Éric, bonjour le forum,

Tu les écris où tes critères ? Tu ne va pas réécrire le code chaque fois que tu changes de critère...

erics83 · 29 Janvier 2022

Merci Robert,
je ne comprends pas la question : j'ai ma feuille "BD", je recherche les données suivant les filtres et j'essaye de donner le résultat fans la feuil3...
Si vous faites allusion à un USB où je pourrais définir les critères, là, je sais faire (merci JB), mais là, ce qui m'intéresse c'est les filtres et tris et la restitution....

Merci pour votre aide,

Robert · 29 Janvier 2022

Re,

Moi, pour proposer un code il me faut d'abord le tester. Puisque tu sais faire une UserForm... Met la dans le fichier... On avisera...

AtTheOne · 29 Janvier 2022

Bonjour à tous Bonjour @erics83 ,

Je ne crois pas que les dictionnaires soit la meilleure façon de traiter ton problème de filtre.
Sauf à faire que les items de ton dictionnaire des Villes soient des dictionnaires des Amis, qui soient eux même des dictionnaires des Niveaux qui renverraient les lignes de ton tableau... bref une usine à gaz.
ainsi MonDicVille("Ville7")("Ami217")("1") renverrait un tableau des amis217 de niveau 1 pour la ville7

Le temps de construction risque d'être long.
(j'ai déjà fait cela pour la gestion d’Équipements de Protection Individuelle, mais c'était pour accéder directement à une seule information à la fois.)

Le filtre avancé est bien plus efficace.

Dans l'exemple que je joins, j'ai d'abord converti les niveaux en nombres (ils étaient sous forme de texte).
J'ai créé des tableaux structurés, et 2 macros pour effacer les anciennes extractions et pour extraire à nouveau :

VB:

Sub Effacer()
Dim Lo As ListObject

     Set Lo = Worksheets("Extraction").ListObjects("_Tb_Extraction")
     Lo.Resize Lo.HeaderRowRange.Resize(2)
     Lo.HeaderRowRange.Offset(1).Resize(Worksheets("Extraction").Rows.Count - Lo.HeaderRowRange.Row).Clear
  
End Sub

Code:

Sub Filtrer()
Dim Rg_Source As Range, Rg_Critères As Range, Rg_Extraction As Range, Lo As ListObject

     Set Rg_Source = Worksheets("BdD").[_Tb_BdD[#All]]
     Set Rg_Critères = Worksheets("Extraction").[_Tb_Critères[#All]]
     Set Rg_Extraction = Worksheets("Extraction").[_Tb_Extraction[#Headers]]
  
     Set Lo = Worksheets("Extraction").ListObjects("_Tb_Extraction")
     Lo.Resize Rg_Extraction.Resize(2)
     Rg_Extraction.Offset(1).Resize(Worksheets("Extraction").Rows.Count - Rg_Extraction.Row).Clear
  
     Rg_Source.AdvancedFilter Action:=xlFilterCopy, _
                             CriteriaRange:=Rg_Critères, _
                             CopyToRange:=Rg_Extraction, _
                             Unique:=False
     'Au cas où le filtre ne renvoie rien Tableau (ListObjet) non redimensionné
     On Error Resume Next
     Lo.Resize Rg_Extraction.CurrentRegion
     On Error GoTo 0
  
End Sub

Attention les cellules au-dessus du tableau d'extraction doivent restées vide (à cause de l'utilisation de .CurrentRegion pour le redimensionnement)

Amicalement
Alain

dysorthographie · 29 Janvier 2022

Bonjour,
Je te propose un filtre élaboré!
j'avais pas fait attention au poste de @erics83 ,

Sub test()
Vantile "Ville7", "Ami217"
End Sub
Public Sub Vantile(Ville As String, Ami As String)
Dim F As Worksheet
Set F = ThisWorkbook.Worksheets.Add(after:=Sheets(Sheets.Count))
F.Name = "filtre"
F.Range("A1:B1") = Array("Ville", "Ami")
F.Range("A2:B2") = Array(Ville, Ami)

With Sheets("Feuil3")
Dim L As Integer: L = .Cells(.Cells.Rows.Count, "A").End(xlUp).Offset(1).Row
FiltreActif Sheets("Bd").UsedRange, F.UsedRange, .Cells(L, "A"), True
.Rows(L).Delete
.Select
End With

Application.DisplayAlerts = False
F.Delete

Application.DisplayAlerts = True
End Sub
Private Function FiltreActif(RangeSource As Range, CriterRange As Range, CopyRange As Range, Optional Unique As Boolean = True) As Boolean
FiltreActif = False
On Error Resume Next
RangeSource.AdvancedFilter Action:= _
xlFilterCopy, CriteriaRange:=CriterRange _
, CopyToRange:=CopyRange, Unique:=Unique
DoEvents
If Err = 0 Then FiltreActif = True
'MsgBox Err.Description
On Error GoTo 0
End Function

patricktoulon · 29 Janvier 2022

bonsoir
avec (index et equiv) evalué avec evaluate en vba ;tu peux chercher ta ligne ou se trouve tes 3 critères directement

patricktoulon · 29 Janvier 2022

re
dans mon foure tout j'ai retrouver ceci:

VB:

Sub Macro4()
'on cherche la ligne ou se trouve (truc , machin , chose) en colonne (A,B et C)
'récuperation de l'index de ligne dans le sheets correspondant au criteres en colonnes "A.B.C"
    criteres = Array("""truc""", """machin""", """chose""")    'criteres a retenir dans le meme ordre que les colonnes
    ColonS = Array("A2:A9", "B2:B9", "C2:C9")    ' colonne a observer pour les criteres dans le meme ordre
    feuille = "Feuil1"    'nom de la feuille
    ligne = Evaluate("=MATCH(1,(" & feuille & "!" & ColonS(0) & "=" & criteres(0) & ")*(" & feuille & "!" & ColonS(1) & "=" & criteres(1) & ")*(" & feuille & "!" & ColonS(2) & "=" & criteres(2) & "),0)") + Range(ColonS(1)).Row - 1
Rows(ligne).Select
Debug.Print "=MATCH(1,(" & feuille & "!" & ColonS(0) & "=" & criteres(0) & ")*(" & feuille & "!" & ColonS(1) & "=" & criteres(1) & ")*(" & feuille & "!" & ColonS(2) & "=" & criteres(2) & "),0)" ' + Range(ColonS(1)).Row - 1
End Sub

Sub Macro5()
'on cherche la ligne ou se trouve (tutu , toto , tete) en colonne (A,B et C)
'récuperation de l'index de ligne dans le sheets correspondant au criteres en colonnes "A.B.C"
    criteres = Array("""tutu""", """toto""", """tete""")    'criteres a retenir dans le meme ordre que les colonnes
    ColonS = Array("A2:A9", "B2:B9", "C2:C9")    ' colonne a observer pour les criteres dans le meme ordre
    feuille = "Feuil1"    'nom de la feuille
    ligne = Evaluate("=MATCH(1,(" & feuille & "!" & ColonS(0) & "=" & criteres(0) & ")*(" & feuille & "!" & ColonS(1) & "=" & criteres(1) & ")*(" & feuille & "!" & ColonS(2) & "=" & criteres(2) & "),0)") + Range(ColonS(1)).Row - 1
Rows(ligne).Select
Debug.Print "=MATCH(1,(" & feuille & "!" & ColonS(0) & "=" & criteres(0) & ")*(" & feuille & "!" & ColonS(1) & "=" & criteres(1) & ")*(" & feuille & "!" & ColonS(2) & "=" & criteres(2) & "),0)" ' + Range(ColonS(1)).Row - 1
End Sub

des que tu choppe la ligne tu peux faire ce que tu veux
les arguments texte entre double guillemets les nombre sans guillemets

trouver la valeur en colonne "D" correspondant a la ligne ou l'on trouve truc , machin , chose en colonne A , B , et C

Code:

Sub macrox6()
   MsgBox Evaluate("INDEX(D1:D13,MATCH(1,(A1:A13=""truc"")*(B1:B13=""machin"")*(C1:C13=""chose""),0))")
End Sub

le même chose en formule ça donne ceci
=INDEX(D113;EQUIV(1;(A1:A13="truc")*(B1:B13="machin")*(C1:C13="chose");0))

il te sera facile de transformer cela en fonction argumentée

dysorthographie · 29 Janvier 2022

Bonsoir Patrick,
Il veut copier le résultat du filtre en feuille3, quoi de mieux qu'un filtre élaboré ?

AtTheOne · 30 Janvier 2022

Bonjour à tous, bonjour @patricktoulon, bonjour @dysorthographie.
En effet le fitre élaboré semble mieux convenir car le filtre donné en exemple renvoie plusieurs lignes.
@erics83, peux-tu nous dire si nos réponses te conviennent, bien que l'on soit éloigné de ta demande initiale : filtrer à l'aide d'un dictionnaire ?
Amicalement
Alain

cp4 · 30 Janvier 2022

Bonsoir @patricktoulon , @dysorthographie , @AtTheOne , @Robert , @erics83 ,

Avec un filtrage via userform.
Bonne soirée.

erics83 · 31 Janvier 2022

Bonjour et merci @patricktoulon , @dysorthographie , @AtTheOne , @Robert , @cp4

Merci pour tous vos apports, j'ai dû mal exprimer mon besoin car on est parti sur les filtres, alors que mon objectif était de travailler et m'entrainer avec Dictionary...j'ai travaillé ce week-end sur le code et....j'ai fait ça et ça fonctionne...mais je ne le trouve pas très "orthodoxe...."
Donc, je suis preneur de vos remarques et/ou observations

VB:

Sub Essai()

Application.Calculation = xlCalculationManual
Feuil1.Select
 Set d = CreateObject("Scripting.Dictionary")
 tbl = Range("A2:H" & [a200000].End(xlUp).Row)
 For i = LBound(tbl) To UBound(tbl)
 If (tbl(i, 5) <= 5 And tbl(i, 6) = "Ville7" And tbl(i, 7) = "Ami217") Then 'recherche niveau<=5 et ville7 et Ami217
   clé = tbl(i, 6) & "|" & tbl(i, 7) & "|" & tbl(i, 4) & "|" & i 'création clef et identification ligne
   d(clé) = ""
End If

 Next i
 j = 0
 Dim b(): ReDim b(1 To d.Count, 1 To 8)
 For Each c In d.keys
   If d(c) = "" Then
     j = j + 1
     a = Split(c, "|")
        For k = 1 To 8
            b(j, k) = tbl(a(3), k) 'rappatriement éléments de la ligne
        Next k
  
   End If
 Next c
 
 
 'Met dans Feuil3

 Feuil2.Select
 Range("A2:H100000").Clear
  [a2].Resize(j, 8) = b
 
 
 Application.Calculation = xlCalculationAutomatic
End Sub

Merci pour votre aide,

cp4 · 31 Janvier 2022

erics83 à dit:
Bonjour et merci @patricktoulon , @dysorthographie , @AtTheOne , @Robert , @cp4

Merci pour tous vos apports, j'ai dû mal exprimer mon besoin car on est parti sur les filtres, alors que mon objectif était de travailler et m'entrainer avec Dictionary...j'ai travaillé ce week-end sur le code et....j'ai fait ça et ça fonctionne...mais je ne le trouve pas très "orthodoxe...."
Donc, je suis preneur de vos remarques et/ou observations

VB:

Sub Essai() Application.Calculation = xlCalculationManual Feuil1.Select Set d = CreateObject("Scripting.Dictionary") tbl = Range("A2:H" & [a200000].End(xlUp).Row) For i = LBound(tbl) To UBound(tbl) If (tbl(i, 5) <= 5 And tbl(i, 6) = "Ville7" And tbl(i, 7) = "Ami217") Then 'recherche niveau<=5 et ville7 et Ami217 clé = tbl(i, 6) & "|" & tbl(i, 7) & "|" & tbl(i, 4) & "|" & i 'création clef et identification ligne d(clé) = "" End If Next i j = 0 Dim b(): ReDim b(1 To d.Count, 1 To 8) For Each c In d.keys If d(c) = "" Then j = j + 1 a = Split(c, "|") For k = 1 To 8 b(j, k) = tbl(a(3), k) 'rappatriement éléments de la ligne Next k End If Next c 'Met dans Feuil3 Feuil2.Select Range("A2:H100000").Clear [a2].Resize(j, 8) = b Application.Calculation = xlCalculationAutomatic End Sub

Merci pour votre aide,

Re,

à mon humble avis ton code est correct. Une autre proposition un peu plus condensée.

VB:

Option Explicit

Sub Macro1()
    Dim plage As Range, dico As Object, Tb(), i As Long, Tr()
    Set dico = CreateObject("Scripting.Dictionary")
    Set plage = ThisWorkbook.Worksheets("bd").Range("A1").CurrentRegion
    Tb = plage.Value

    For i = 1 To UBound(Tb)
        If Tb(i, 5) <= 5 And Tb(i, 6) = "Ville7" And Tb(i, 7) = "Ami217" Then
            dico(Tb(i, 1) & "|" & Tb(i, 2) & "|" & Tb(i, 3) & "|" & Tb(i, 4) & "|" & Tb(i, 5) & "|" & _
                 Tb(i, 6) & "|" & Tb(i, 7) & "|" & Tb(i, 8)) = ""
        End If
    Next i

    With Feuil2
        .Activate
        .Range("A1").CurrentRegion.ClearContents
        .Range("A1").Resize(dico.Count) = Application.Transpose(dico.Keys)
        Application.DisplayAlerts = False
        .Columns(1).TextToColumns DataType:=xlDelimited, Other:=True, OtherChar:="|"    'éclater colonne 1 en plusieurs suivant delimiteur choisi ("|")
        Application.DisplayAlerts = True
        .Rows(1).AutoFit    'ajuste hauteur 1ère ligne
    End With
End Sub

erics83 · 31 Janvier 2022

Super merci cp4,

C'est ce que j'attendais : voir comprendre et utiliser les dictionnaires et là, vous me montrez comment encore m'améliorer !!! MERCI

Merci pour votre aide,

patricktoulon · 31 Janvier 2022

on peu aller plus loin que ca
1° ton test( If d(c) = "" Then)ne sert strictement à rien puisque tu met rien dans l'item des keys de dico
2° pour quoi vous faite pas le tableau en même temps ?

XL 2013 Aide sur Dictionary : recherche et restitution

erics83

XLDnaute Impliqué

Pièces jointes

Robert

XLDnaute Barbatruc

erics83

XLDnaute Impliqué

Robert

XLDnaute Barbatruc

AtTheOne

XLDnaute Impliqué

Pièces jointes

dysorthographie

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

dysorthographie

XLDnaute Accro

AtTheOne

XLDnaute Impliqué

cp4

XLDnaute Barbatruc

Pièces jointes

erics83

XLDnaute Impliqué

cp4

XLDnaute Barbatruc

erics83

XLDnaute Impliqué

patricktoulon

XLDnaute Barbatruc

Discussions similaires