Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Transférer le contenu de Dictionary dans une plage

6 réponses
Avatar
garnote
Bonjour,

Comment faire pour transférer mondico
dans une plage, partant de la cellule active
et s'allongeant vers le bas, sans passer par une boucle ?
Plage "MPFE" : Suite de noms sur une même colonne.
Comment Dimer mondico et dict ?
Et dois-je absolument passer par dict ?

Sub Dictionnaire()
Dim ici As Range, c As Range
Dim i As Long
'Dim mondico as ?
'Dim dict as ?
Set ici = ActiveCell
Set mondico = CreateObject("Scripting.Dictionary")
For Each c In Range("MPFE")
If Not mondico.Exists(c.Value) Then mondico.Add c.Value, c.Value
Next c
dict = mondico.keys
For i = 0 To mondico.Count - 1
ici.Offset(i, 0).Value = dict(i)
Next
End Sub


Un GROS marci,
Serge

6 réponses

Avatar
JB
Bonjour,

[a2].Resize(mondico.Count) = Application.Transpose(mondico.keys)
[b2].Resize(mondico.Count) = Application.Transpose(mondico.items)

http://boisgontierjacques.free.fr/pages_site/Dictionnaire.htm

JB

On 14 août, 15:57, "garnote" wrote:
Bonjour,

Comment faire pour transférer mondico
dans une plage, partant de la cellule active
et s'allongeant vers le bas, sans passer par une boucle ?
Plage "MPFE" : Suite de noms sur une même colonne.
Comment Dimer mondico et dict ?
Et dois-je absolument passer par dict ?

Sub Dictionnaire()
    Dim ici As Range, c As Range
    Dim i As Long
    'Dim mondico as ?
    'Dim dict as ?
    Set ici = ActiveCell
    Set mondico = CreateObject("Scripting.Dictionary")
    For Each c In Range("MPFE")
        If Not mondico.Exists(c.Value) Then mondico.Add c.Value, c.Value
    Next c
    dict = mondico.keys
    For i = 0 To mondico.Count - 1
        ici.Offset(i, 0).Value = dict(i)
    Next
End Sub

Un GROS marci,
Serge


Avatar
FS
Bonjour Serge,

> Comment Dimer mondico et dict ?

Tu as le choix entre 2 méthodes. Tu as choisi le 'late binding' en
utilisant cette ligne de code pour créer ton objet dictionnaire :

Set mondico = CreateObject("Scripting.Dictionary")

Dans ce cas, l'objet Dictionary étant inconnu au moment de la
compilation, tu dois le déclarer en Variant. Keys est une fonction de
l'objet Dictionary. Ta variable dict récupère le résultat de Keys (qui
renvoie un tableau de base 0). Tu peux la déclarer en Variant également.

Pour revenir à mondico, tu pourrais aussi choisir la méthode dite 'early
binding' en déclarant la librairie 'Microsoft Scripting Runtime' dans
les références de ton VBAProject.

Dans ce cas, tu peux déclarer mondico As Dictionary et même
mondico As New Dictionary
ce qui t'économise ensuite une ligne de code.

FS
--
Frédéric SIGONNEAU
Modules et modèles pour Excel :
http://frederic.sigonneau.free.fr/

garnote a écrit :
Bonjour,

Comment faire pour transférer mondico
dans une plage, partant de la cellule active
et s'allongeant vers le bas, sans passer par une boucle ?
Plage "MPFE" : Suite de noms sur une même colonne.
Comment Dimer mondico et dict ?
Et dois-je absolument passer par dict ?

Sub Dictionnaire()
Dim ici As Range, c As Range
Dim i As Long
'Dim mondico as ?
'Dim dict as ?
Set ici = ActiveCell
Set mondico = CreateObject("Scripting.Dictionary")
For Each c In Range("MPFE")
If Not mondico.Exists(c.Value) Then mondico.Add c.Value, c.Value
Next c
dict = mondico.keys
For i = 0 To mondico.Count - 1
ici.Offset(i, 0).Value = dict(i)
Next
End Sub


Un GROS marci,
Serge




Avatar
garnote
Merci à vous deux et bonne fin de semaine,
pardon, bon week-end ;-)

Serge
Avatar
Modeste
Salut Fred avec ferveur ;o)) vous nous disiez :
Tu as le choix entre 2 méthodes. Tu as choisi le 'late binding' ....
..... tu pourrais aussi choisir la méthode dite
'early binding' en déclarant la librairie 'Microsoft Scripting
Runtime' dans les références de ton VBAProject.



pour pouvoir activer le early binding lors du Workbook_open
il serait interessant de connaitre le GUId' Microsoft Scripting Runtime'

Private Sub Workbook_Open()
On Error Resume Next
' ------- Add Microsoft Scripting Runtime object library
ActiveWorkbook.VBProject.References.AddFromGuid "{GUId' Microsoft Scripting Runtime'}", 5, 0
.....
.....
End Sub

ou peut-on trouver la liste de ces fameux GUId ???
;o)))
Avatar
MichDenis
Bonjour Modeste,

Tu places devant la ligne de code car celui-ci
provoque une erreur si la référence est déjà
chargée:

On error resume next
ActiveWorkbook.VBProject.References.AddFromGuid _
"{420B2830-E718-11CF-893D-00A0C9054228}", major:=1, Minor:=0

Et pour trouver le Guid d'une référence,
A ) tu coches manuellement la référence désirée
et tu exécutes cette macro pour obtenir les
propriétés de toutes les références chargées.
B ) lorsque tu as obtenu l'information, tu peux la décocher...

'-----------------------------------
Dim Ref As Object
With ActiveWorkbook
For Each Ref In .VBProject.References
Range("A" & A + 1) = Ref.Name
Range("b" & A + 1) = Ref.Minor
Range("c" & A + 1) = Ref.major
Range("D" & A + 1) = Ref.GUID
A = A + 1
Next
End With
'-----------------------------------



"Modeste" a écrit dans le message de groupe de discussion :

Salut Fred avec ferveur ;o)) vous nous disiez :
Tu as le choix entre 2 méthodes. Tu as choisi le 'late binding' ....
..... tu pourrais aussi choisir la méthode dite
'early binding' en déclarant la librairie 'Microsoft Scripting
Runtime' dans les références de ton VBAProject.



pour pouvoir activer le early binding lors du Workbook_open
il serait interessant de connaitre le GUId' Microsoft Scripting Runtime'

Private Sub Workbook_Open()
On Error Resume Next
' ------- Add Microsoft Scripting Runtime object library
ActiveWorkbook.VBProject.References.AddFromGuid "{GUId' Microsoft Scripting
Runtime'}", 5, 0
.....
.....
End Sub

ou peut-on trouver la liste de ces fameux GUId ???
;o)))
Avatar
Modeste
Bonsour® MichDenis avec ferveur ;o))) vous nous disiez :

Et pour trouver le Guid d'une référence,
A ) tu coches manuellement la référence désirée
et tu exécutes cette macro pour obtenir les
propriétés de toutes les références chargées.
B ) lorsque tu as obtenu l'information, tu peux la décocher...

'-----------------------------------
Dim Ref As Object
With ActiveWorkbook
For Each Ref In .VBProject.References
Range("A" & A + 1) = Ref.Name
Range("b" & A + 1) = Ref.Minor
Range("c" & A + 1) = Ref.major
Range("D" & A + 1) = Ref.GUID
A = A + 1
Next
End With
'-----------------------------------



Un grand "Merci" Denis,
tu nous avais déja fourni ici cette solution, mais je n'en retrouvais plus de trace...
@+