Discussion :

[Passepartout007]

Bonjour

J'ai un dictionnaire replis avec seulement une ligne de données,
Je voudrais remplir un tableau nommé ici Montableau avec la liste du dictionnaire.

j'ai essayer cela :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
 
 
Public MonTablo As ListObject
Sub Incementationlist()
Dim num a long
Set MonTablo = ThisWorkbook.Sheets(FeuilleList).ListObjects("List_ObservationFTS")
num = 0
        For Each Item In LList.Keys
        MsgBox Item
MonTablo.ListRows.Add Item.Value, Item.Value
 
        Next Item
End Sub

Cependant cela ne fonctionne pas avez vous des idées ?
Cordialement,
Passepartout007

[Passepartout007]

Bonjour,

j'ai donc une macro qui parcours ma base de donnée et qui incrémente des listes suivant des critères. Cela fonctionne parfaitement à l'exception du temps de traitement qui est faramineux ...
Déclaration des variable public

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Public Feuillebase As String
Public FeuilleList As String
Public PlageBase As Range
Public Plagetype As Range
Public PlageList As Range
Public NumColList As Long
Public NumColBase As Long
Public Types As String

Définition des variable suivant les cas :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
Sub listTypeFTS()
Feuillebase = "Base de données"
FeuilleList = "ListesFTS"
Set Plagetype = ThisWorkbook.Sheets(Feuillebase).Range("C2:C" & Sheets(Feuillebase).[C1048576].End(xlUp).Row)
Set PlageBase = ThisWorkbook.Sheets(Feuillebase).Range("C2:C" & Sheets(Feuillebase).[C1048576].End(xlUp).Row)
Set PlageList = ThisWorkbook.Sheets(FeuilleList).Range("A2:A" & Sheets(FeuilleList).[A1048576].End(xlUp).Row)
Types = "FT"
 
Set MonTablo = ThisWorkbook.Sheets(FeuilleList).ListObjects("List_TypeFTS")
 
NumColList = 1
NumColBase = 3
Call Incementationlist
End Sub
Sub listMaterielFTS()
Feuillebase = "Base de données"
FeuilleList = "ListesFTS"
Set Plagetype = ThisWorkbook.Sheets(Feuillebase).Range("C2:C" & Sheets(Feuillebase).[C1048576].End(xlUp).Row)
Set PlageBase = ThisWorkbook.Sheets(Feuillebase).Range("D2:D" & Sheets(Feuillebase).[D1048576].End(xlUp).Row)
Set PlageList = ThisWorkbook.Sheets(FeuilleList).Range("B2:B" & Sheets(FeuilleList).[B1048576].End(xlUp).Row)
Types = "FT"
 
Set MonTablo = ThisWorkbook.Sheets(FeuilleList).ListObjects("List_MaterielFTS")
 
NumColList = 2
NumColBase = 4
Call Incementationlist
End Sub
Sub listTacheFTS()
Feuillebase = "Base de données"
FeuilleList = "ListesFTS"
Set Plagetype = ThisWorkbook.Sheets(Feuillebase).Range("C2:C" & Sheets(Feuillebase).[C1048576].End(xlUp).Row)
Set PlageBase = ThisWorkbook.Sheets(Feuillebase).Range("F2:F" & Sheets(Feuillebase).[F1048576].End(xlUp).Row)
Set PlageList = ThisWorkbook.Sheets(FeuilleList).Range("C2:C" & Sheets(FeuilleList).[C1048576].End(xlUp).Row)
Types = "FT"
Set MonTablo = ThisWorkbook.Sheets(FeuilleList).ListObjects("List_TacheFTS")
NumColList = 3
NumColBase = 6
Call Incementationlist
End Sub
Sub listVersionFTS()
Feuillebase = "Base de données"
FeuilleList = "ListesFTS"
Set Plagetype = ThisWorkbook.Sheets(Feuillebase).Range("C2:C" & Sheets(Feuillebase).[C1048576].End(xlUp).Row)
Set PlageBase = ThisWorkbook.Sheets(Feuillebase).Range("G2:G" & Sheets(Feuillebase).[G1048576].End(xlUp).Row)
Set PlageList = ThisWorkbook.Sheets(FeuilleList).Range("D2:D" & Sheets(FeuilleList).[D1048576].End(xlUp).Row)
Types = "FT"
Set MonTablo = ThisWorkbook.Sheets(FeuilleList).ListObjects("List_VersionFTS")
NumColList = 4
NumColBase = 7
Call Incementationlist
End Sub
 
Sub listObservationFTS()
Feuillebase = "Base de données"
FeuilleList = "ListesFTS"
Set Plagetype = ThisWorkbook.Sheets(Feuillebase).Range("C2:C" & Sheets(Feuillebase).[C1048576].End(xlUp).Row)
Set PlageBase = ThisWorkbook.Sheets(Feuillebase).Range("H2:H" & Sheets(Feuillebase).[H1048576].End(xlUp).Row)
Set PlageList = ThisWorkbook.Sheets(FeuilleList).Range("E2:E" & Sheets(FeuilleList).[E1048576].End(xlUp).Row)
Types = "FT"
Set MonTablo = ThisWorkbook.Sheets(FeuilleList).ListObjects("List_ObservationFTS")
NumColList = 5
NumColBase = 8
Call Incementationlist
End Sub

Macro qui met à jours les listes en parcourant la base de données :
Supprime toute les ligne du tableau (une par une ) cela fais surement beaucoup ralentir le tableau.
Je créer un dictionnaire dans le quel j'incrémente les données filtré comme il faut.
Puis j'ajoute ce dicitionnaire au tableau lui correspondant ligne par ligne encore une fois, ce qui fais ralentir la macro ...
Voici le code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
Sub listTypeFTS()
Feuillebase = "Base de données"
FeuilleList = "ListesFTS"
Set Plagetype = ThisWorkbook.Sheets(Feuillebase).Range("C2:C" & Sheets(Feuillebase).[C1048576].End(xlUp).Row)
Set PlageBase = ThisWorkbook.Sheets(Feuillebase).Range("C2:C" & Sheets(Feuillebase).[C1048576].End(xlUp).Row)
Set PlageList = ThisWorkbook.Sheets(FeuilleList).Range("A2:A" & Sheets(FeuilleList).[A1048576].End(xlUp).Row)
Types = "FT"
 
Set MonTablo = ThisWorkbook.Sheets(FeuilleList).ListObjects("List_TypeFTS")
 
NumColList = 1
NumColBase = 3
Call Incementationlist
End Sub
Sub listMaterielFTS()
Feuillebase = "Base de données"
FeuilleList = "ListesFTS"
Set Plagetype = ThisWorkbook.Sheets(Feuillebase).Range("C2:C" & Sheets(Feuillebase).[C1048576].End(xlUp).Row)
Set PlageBase = ThisWorkbook.Sheets(Feuillebase).Range("D2:D" & Sheets(Feuillebase).[D1048576].End(xlUp).Row)
Set PlageList = ThisWorkbook.Sheets(FeuilleList).Range("B2:B" & Sheets(FeuilleList).[B1048576].End(xlUp).Row)
Types = "FT"
 
Set MonTablo = ThisWorkbook.Sheets(FeuilleList).ListObjects("List_MaterielFTS")
 
NumColList = 2
NumColBase = 4
Call Incementationlist
End Sub
Sub listTacheFTS()
Feuillebase = "Base de données"
FeuilleList = "ListesFTS"
Set Plagetype = ThisWorkbook.Sheets(Feuillebase).Range("C2:C" & Sheets(Feuillebase).[C1048576].End(xlUp).Row)
Set PlageBase = ThisWorkbook.Sheets(Feuillebase).Range("F2:F" & Sheets(Feuillebase).[F1048576].End(xlUp).Row)
Set PlageList = ThisWorkbook.Sheets(FeuilleList).Range("C2:C" & Sheets(FeuilleList).[C1048576].End(xlUp).Row)
Types = "FT"
Set MonTablo = ThisWorkbook.Sheets(FeuilleList).ListObjects("List_TacheFTS")
NumColList = 3
NumColBase = 6
Call Incementationlist
End Sub
Sub listVersionFTS()
Feuillebase = "Base de données"
FeuilleList = "ListesFTS"
Set Plagetype = ThisWorkbook.Sheets(Feuillebase).Range("C2:C" & Sheets(Feuillebase).[C1048576].End(xlUp).Row)
Set PlageBase = ThisWorkbook.Sheets(Feuillebase).Range("G2:G" & Sheets(Feuillebase).[G1048576].End(xlUp).Row)
Set PlageList = ThisWorkbook.Sheets(FeuilleList).Range("D2:D" & Sheets(FeuilleList).[D1048576].End(xlUp).Row)
Types = "FT"
Set MonTablo = ThisWorkbook.Sheets(FeuilleList).ListObjects("List_VersionFTS")
NumColList = 4
NumColBase = 7
Call Incementationlist
End Sub
 
Sub listObservationFTS()
Feuillebase = "Base de données"
FeuilleList = "ListesFTS"
Set Plagetype = ThisWorkbook.Sheets(Feuillebase).Range("C2:C" & Sheets(Feuillebase).[C1048576].End(xlUp).Row)
Set PlageBase = ThisWorkbook.Sheets(Feuillebase).Range("H2:H" & Sheets(Feuillebase).[H1048576].End(xlUp).Row)
Set PlageList = ThisWorkbook.Sheets(FeuilleList).Range("E2:E" & Sheets(FeuilleList).[E1048576].End(xlUp).Row)
Types = "FT"
Set MonTablo = ThisWorkbook.Sheets(FeuilleList).ListObjects("List_ObservationFTS")
NumColList = 5
NumColBase = 8
Call Incementationlist
End Sub

N'existe-t-il pas un moyen de dire :

Clear toute les lignes de mon tableau nommés sans les traité un par un.
Ajoute tout les items du dictionnaire dans mon tableau nommé. Sans les traités un par un ..
Cordialement,
Passepartout007

[joe.levrai]

Bonjour,

Clear toute les lignes de mon tableau nommés sans les traité un par un.

Clear ou Delete ?

Clear les lignes de données n'a pas de réel sens, dans la mesure où le tableau se redimensionne automatiquement quand on écrit sur la ligne en dessous des données

Il n'est pas possible de supprimer toutes lignes de données d'un tableau structuré, il faut en laisser au moins une. Et quand on veut réutiliser le tableau, on va simplement écraser la première ligne avec les nouvelles données

Une procédure qui supprime les données et ne laisse que la première ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Sub EffaceListObject(LeTablo As ListObject)
    With LeTablo
        If .ListRows.Count > 2 Then .DataBodyRange.Resize(.ListRows.Count - 1, .ListColumns.Count).Offset(1, 0).Delete
    End With
End Sub

Ajoute tout les items du dictionnaire dans mon tableau nommé. Sans les traités un par un

On parle des items sans les clés ?

Exemple à l'arrache avec les Items et les clés, dans un tableau structuré bidon qui ne possède que ces deux colonnes

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub toto()
Dim MonDico As Object, Tablo As ListObject, i As Long
Const SEP As String = "$"
Set MonDico = CreateObject("Scripting.Dictionary")
Set Tablo = Feuil1.ListObjects(1)
 
    For i = 1 To 100
        MonDico.Add i, i & SEP
    Next i
 
    With Tablo
        .Resize (.Parent.Range(.Range.Cells(1, 1).Address, .Range.Cells(1, 1).Offset(MonDico.Count, .ListColumns.Count - 1)))
        .ListColumns("KEYS").DataBodyRange.Value = Application.Transpose(MonDico.keys)
        .ListColumns("ITEMS").DataBodyRange.Value = Application.Transpose(MonDico.items)
    End With
End Sub

[Passepartout007]

Bonjour,

Grace a ton code je viens de comprend enfin comment bien utiliser un dictionnaire !!!!!!

Encore merci à toi tout fonctionne parfaitement <3
Le faite qu'il n'y ai pas de commentaire sur ton code m'à fais chercher et du coup j'ai compris ! héhé

Cordialement,
Passepartout007

[boisgontierjacques]

Bonsoir,

Je n'ai pas compris le but.
-Exercice sur le dictionnaire?
-Exercice sur les tableaux?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub TransfertDicoTableau()
  NomTableau = "Tableau3"
  n = Range(NomTableau).Rows.Count
  If n > 1 Then Range(NomTableau).Rows(2).Resize(n - 1).Delete
  Set d = CreateObject("scripting.dictionary")
  For i = 1 To 10: d(i) = i * i: Next i
  Range(NomTableau).Columns(1).Resize(d.Count) = Application.Transpose(d.keys)
  Range(NomTableau).Columns(2) = Application.Transpose(d.items)
End Sub

S'il s'agit d'un exo sur le dico,Je pense que cette version doit être plus rapide:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
Sub TransfertDicoRange()
  Set d = CreateObject("scripting.dictionary")
  For i = 1 To 10: d(i) = i * i: Next i
  [D2].Resize(d.Count) = Application.Transpose(d.keys)
  [D2].Offset(, 1).Resize(d.Count) = Application.Transpose(d.items)
End Sub

Boisgontier

[Passepartout007]

Bonjour, vous deux,

Boisgontierjacques la solution que tu propose pour l'incrémentation de tableau si j'ai bien compris est la même que celle de Joe.levrai et sera donc de la même rapidité ?
Cordialement,
Passepartout007