Retourner un Dictionnaire Dans une fonction Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
r
riri785
Nouveau venu
Nouveau venu
Messages : 2
Inscrit le : 19 février 2019

Message par riri785 » 19 février 2019, 11:38

Bonjour,

Je cherche à réaliser une fonction récursive qui vas ajouter toutes les valeurs des cellules de deux colonnes dans un Dictionnaire.
J'ai donc fait ça :
Public Function rec_get_all_dum(start_row, res)
    
    If Not IsEmpty(Cells(start_row, 1)) Then
        res.Add Cells(start_row, 1), Cells(start_row, 2)
        res = rec_get_all_dum(start_row + 1, res)
    End If

    Set rec_get_all_dum = res
 
End Function
Et je lance ma fonction comme cela :
Set res = CreateObject("Scripting.Dictionary")
all = Feuil2.rec_get_all_dum(2, res)
A priori la fonction récursive fonctionne en elle même, mais je croit que c'est le fait de retourner un Dictionary le probléme (mais je suis pas sûr)
Voila l'erreur que ça affiche :
"Nombre d'arguments incorrect ou affectation de propriété incorrecte"

SI vous avez une piste je suis preneur :)
h
h2so4
Passionné d'Excel
Passionné d'Excel
Messages : 7'802
Appréciations reçues : 216
Inscrit le : 16 juin 2013
Version d'Excel : 2013 UK Windows 10

Message par h2so4 » 19 février 2019, 12:23

bonjour,

comme tu passes le dictionnaire dans les paramètres pas besoin de définir une fonction une sub suffit.
Public Sub rec_get_all_dum(start_row, res)
'sub récursive, mais je ne vois pas la nécessité de cette récursivité (voir sub alternative ci-dessous)
    If Not IsEmpty(Cells(start_row, 1)) Then
        res.Add Cells(start_row, 1), Cells(start_row, 2)
        rec_get_all_dum start_row + 1, res
    End If
End Sub


Sub test()
    Set res = CreateObject("scripting.dictionary")
    rec_get_all_dum 2, res
    'loadres 2, res
    all = res.Keys
    Cells(1, 3).Resize(res.Count) = Application.Transpose(all)
    all=res.items
    Cells(1, 4).Resize(res.Count) = Application.Transpose(all)
End Sub

' sub alternative non récursive 
Sub loadres(ByVal start_row, res)
    While Not IsEmpty(Cells(start_row, 1))
        res.Add Cells(start_row, 1), Cells(start_row, 2)
        start_row = start_row + 1
    Wend
End Sub

voici une exemple de retour d'un dictionnaire dans une fonction
Sub aargh()
    Set r = createdict(2)
    all = r.Keys
    Cells(1, 3).Resize(r.Count) = Application.Transpose(all)
    all = r.Items
    Cells(1, 4).Resize(r.Count) = Application.Transpose(all)
End Sub

Function createdict(start_row)
    Set res = CreateObject("scripting.dictionary")
    While Not IsEmpty(Cells(start_row, 1))
        res.Add Cells(start_row, 1), Cells(start_row, 2)
        start_row = start_row + 1
    Wend
    Set createdict = res
End Function
T
Theze
Passionné d'Excel
Passionné d'Excel
Messages : 3'340
Appréciations reçues : 216
Inscrit le : 26 janvier 2011
Version d'Excel : 2007

Message par Theze » 19 février 2019, 13:37

Bonjour,

Ta fonction récursive fonctionne bien le seul problème c'est qu'il te faut garder à l'esprit que l'affectation d'un objet à une variable se fait toujours avec l'instruction Set :
Sub Test()

    Dim Res As Object
    Dim I As Integer
    Dim Cle
    Dim Elem
    
    Set Res = CreateObject("Scripting.Dictionary")
    Set Res = rec_get_all_dum(ActiveSheet, 2, Res)
    
    For Each Elem In Res.Items: Debug.Print "valeur de l'item : "; Elem: Next Elem
    
    For Each Cle In Res.Keys: Debug.Print "valeur de la clé : "; Cle: Next Cle
     
End Sub

Public Function rec_get_all_dum(Fe As Worksheet, start_row, Res) As Object
    
    With Fe
    
        If Not IsEmpty(.Cells(start_row, 1)) Then
        
            Res.Add .Cells(start_row, 1).Value, .Cells(start_row, 2).Value
            Set Res = rec_get_all_dum(Fe, start_row + 1, Res)
            
        End If
    
    End With
    
    Set rec_get_all_dum = Res
 
End Function
r
riri785
Nouveau venu
Nouveau venu
Messages : 2
Inscrit le : 19 février 2019

Message par riri785 » 19 février 2019, 13:48

Merci beaucoup pour vos réponses très claires ! :o

Effectivement pour le set j'avais oublier quand l'utiliser donc merci :)

Ha oui effectivement c'est bien plus propre avec le sub sans return pour le coup :-)))

Et pour le moment le récursif n'est effectivement pas utile mais la fonction vas un peu se compliquer par la suite.

Encore merci pour vos réponses ! :)
T
Theze
Passionné d'Excel
Passionné d'Excel
Messages : 3'340
Appréciations reçues : 216
Inscrit le : 26 janvier 2011
Version d'Excel : 2007

Message par Theze » 19 février 2019, 13:50

Petite précision concernant les fonctions récursives, elles sont, selon le cas, gourmande en mémoire et limitées dans la pile des appels qu'elles créent, un petit exemple que j'ai donné dans un autre post avec la fonction récursive très connue, la factorielle. Pour tester et comprendre le fonctionnement d'un fonction récursive, lancer la sub "Test" en pas à pas avec F8 pour avoir la factorielle de 10 et regarder dans la fenêtre d'exécution (Ctrl+G) :
Sub test()

    MsgBox Factorielle(10)
    
End Sub

Function Factorielle(Nb As Integer)
    
    'déclarées en static pour garder en mémoire les valeurs
    Static Rappel As Integer
    Static Fin As Boolean
    
    Rappel = Rappel + 1: Debug.Print Rappel
    
    If Nb = 1 Then 'Point de sortie, absolument obligatoire pour éviter une boucle sans fin !
    
        Factorielle = 1
        Fin = True
        Debug.Print "Maintenant, phase de calcul !"
        
    Else
        
        'à chaque appel, le résultat est stoké en mémoire
        'ce qui crée unne pile des appels
        Factorielle = Nb * Factorielle(Nb - 1)
        
    End If
    
    'on remonte la pile des appels
    If Fin = True Then Rappel = Rappel - 1: Debug.Print Rappel

End Function
Ce qu'il est possible de voir avec ta fonction :
Public Function rec_get_all_dum(Fe As Worksheet, start_row, Res) As Object

    Static Pos As Integer 'Static permet de garder en mémoire comme une variable déclarée en tête de module
    
    With Fe
    
        If Not IsEmpty(.Cells(start_row, 1)) Then
        
            Res.Add .Cells(start_row, 1).Value, .Cells(start_row, 2).Value
            Set Res = rec_get_all_dum(Fe, start_row + 1, Res)
            
        End If
    
    End With
    
    Stop 'arrête le déroulement du code pour permettre la suite avec F8 !
    Pos = Pos + 1
    Debug.Print "Appel de la pile numéro : "; Pos
    
    Set rec_get_all_dum = Res
 
End Function
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message