Création, Analyse et Gestion d'une base de données via dictionnaires [VBA] Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
A
Alexandre74006
Jeune membre
Jeune membre
Messages : 20
Inscrit le : 27 novembre 2018
Version d'Excel : 2016 FR

Message par Alexandre74006 » 1 décembre 2018, 20:14

Bonjour à tous,

A partir d'une base de données d'environ 350 000 items, je souhaiterais créer un programme VBA qui automatise un filtrage de ces données selon différents critères.

Pour vous expliquer un peu plus en détails, cette base de données recense les données de différentes sociétés sur 8 feuilles correspondant à 8 années. Mais attention : il y a des doublons, chaque société n'est pas présente toutes les années, leur position varie au cours du temps et le nombre de sociétés varie chaque année. La première colonne correspond au nom de la société et les colonnes qui suivent correspondent à différents critères (et ce, sur chacune des feuilles).Prenons par exemple la société VOLVO. Elle se situe en l'année 2000 ligne 2150, en 2001 ligne 2152 mais n'est plus dans la base de données les années suivantes.

Du fait de ces contraintes, je pense qu'il est judicieux de passer par des dictionnaires pour stocker, manipuler la base de données et extraire les données qui m’intéressent.

La stratégie du code serait de :
  • Stocker la data un dictionnaire qui contiendra des sous-dictionnaires (un sous-dictionnaire par année, un sous-dictionnaire contenant toutes les données d'une feuille)
  • Appliquer une série de fonction pour filtrer la data
  • Exporter les sociétés et les données associées vers un dictionnaire de sortie (qu'on peut appellera Pfolio)
  • Exporter les données du dictionnaire Pfolio vers des feuilles (une feuille par année)
Comme vous vous en doutiez, je rencontre quelques difficultés. Je souhaiterais que mon dictionnaire se présente comme ceci : dico(Anne)(Ticker) = Tableau de toutes les données associées (donc un tableau de la ligne du ticker associé qui contient les colonnes 2 à 22). Dans l'idée j'aimerais pouvoir par exemple chercher une donnée comme ceci : dico(Annee)(Ticker).(Critère) --> qui renvoie la valeur du critère choisi pour un société à une année donnée. ex : dico (2010)("VOLVO").("Cours") = 10$

Je ne sais pas si j'ai été assez clair et compréhensible.. Donc pour récapituler, l'idée est de créer un dictionnaire de dictionnaires : Dico_Principal (Key : Annee, Item : Dico_ Annee) et 8 dictionnaires (Key : Ticker (Nom_Societe), Item : Array (des données de la société (donc à une année donnée pour une société donnée) : une donnée par colonne)).

Vous trouverez ci-joint un partie de ma base de donnée. Malheureusement, ce n'est qu'une partie car le fichier était trop volumineux. Je n'ai conservé que la feuille "2010" mais les autres feuilles sont similaires (de 2008 à 2015).

Grace à l'aide de @Klin89 j'ai pu aboutir à ceci :
Sub test()
Dim a, b, i As Long
Dim ws As Worksheet
Dim dico As Object

    'creation des dictionnaires
    Set dico = CreateObject("Scripting.Dictionary")
    Set pfolio = CreateObject("Scripting.Dictionary")
    
    For Each ws In Worksheets
        
        'création des "sous-dictionnaires"
        Set dico(CStr(ws.Name)) = CreateObject("Scripting.Dictionary") 'création du dictionnaire principal
        Set pfolio(CStr(ws.Name)) = CreateObjet("Scripting.Dictionary") 'création du dictionnaire portefeuille
        
        'Création d'une feuille pfolio poour les données futures
        'Sheets.Add(After:=Worksheets(Worksheets.Count())).Name = ("Pfolio" & Cstr(Annee))
            'Mise en forme ?
                
        With ws
            a = .Range("A1").CurrentRegion.Value
            
            For i = 2 To UBound(a, 1)
                'On vérifie que la société ne soit pas dans le dictionnaire
                If Not dico(CStr(ws.Name)).Exists(a(i, 1)) Then
                
                    dico(CStr(ws.Name))(a(i, 1)) = Application.Index(a, i, 0) 
                    'Je crois que la fonction Application.Index prend beaucoup de mémoire 
                    'J'ai commencer à écrire function Extraire_ligne ci-dessous mais elle comporte une erreur que j'arrive pas à trouver
                    'dico(CStr(ws.Name))(a(i, 1)) = Extraire_ligne(a, i)
                    
                End If
            Next
        End With
    Next
    
    'Set dico = Nothing
    
Dim Annee As Variant
Dim ticker As Variant
    'Partie filtrage de données à partir de l'année 2010 
    'Je ne sais pas trop comment m'y prendre mais l'idée de parcourir le dico ticker par ticker, année après année
    For Each Annee In dico 'Pour parcourir le dictionnaire_principal de l'année 2010 à la dernière année
    	'annee : 2010 to 2015
   
        For Each ticker In dico(Annee)(ticker) 'parcourir le dictionnaire_principal ticker par ticker
        
            'Il y a aura ici une série de filtres 
	    'Je ferais appel à des fonctions tel que : 
	    'function critère1(dico as dico, ticker as string, indicateur as string) 
	    'exemple ticker : dico(2011)(Ticker) = "VOLVO"
	    'exemple d'indicateur : "cours","capitalisation boursière" etc. (1ère ligne de la bd)
	    
            'Si une société passe les filtres alors Affectation des données de la société vers le dictionnaire pfolio :
            
 
            'Extraction des données : Transfert et envoi vers le portefeuille (qui est lui aussi un dico contenant des sous-dico année par année)
            
	    'Envoie des données sur les feuilles - à développer
                        
        Next
    Next
   
End Sub

Function Extraire_ligne(a As Variant, ligne As Double) As Variant

'Je n'arrive pas retourner en sortie de function un tableau
'sensé alléger le temps d'éxecution à la place de application.index
Dim b(1 To ubound(a,2)-1) As Variant
Dim i As Integer

For i = LBound(a, 2) To UBound(a, 2)

    b(i) = a(ligne, i)
    
    Debug.Print b(i), a(ligne, i)

Next i

'Extraire_ligne = b()

End Function
Par ailleurs, je souhaiterais réduire le temps d’exécution (très long avec application.index) en créant une fonction extraire ligne mais je n'arrive pas à réaliser cette fonction, elle comporte une erreur..

En espérant avoir été assez clair et explicite, n'hésitez pas à m'interpeller dans le cas contraire :)

Merci d'avance pour votre aide,
Alexandre
DATA_help.xlsx
fichier trop volumineux, je n'ai pu mettre que la feuille en 2010. Cette feuille 2010 est une base, dans mon fichier initial contient 8 feuilles comme celle-ci.
(476 Kio) Téléchargé 10 fois
Avatar du membre
Klin89
Membre dévoué
Membre dévoué
Messages : 596
Appréciations reçues : 21
Inscrit le : 28 mai 2011
Version d'Excel : 2003 FR

Message par Klin89 » 2 décembre 2018, 00:01

Bonsoir à tous, :)

Alexandre74006 : une simple formule avec Index Match devrait suffire non :oops:

Sinon pour t'aider ::o
Option Explicit
Sub test()
Dim a, i As Long, j As Long, dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    a = Sheets("2010").Range("a1").CurrentRegion.Value
    For i = 2 To UBound(a, 1)
        If Not dico.exists(a(i, 1)) Then
            Set dico(a(i, 1)) = CreateObject("Scripting.Dictionary")
            dico(a(i, 1)).CompareMode = 1
        End If
        For j = 2 To UBound(a, 2)
            dico(a(i, 1))(a(1, j)) = a(i, j)
        Next
    Next
    Set dico = Nothing
End Sub
Des dictionnaires de dictionnaires de dictionnaires, ça risque d'être lourd à traiter :cry:

klin89
Avatar du membre
Klin89
Membre dévoué
Membre dévoué
Messages : 596
Appréciations reçues : 21
Inscrit le : 28 mai 2011
Version d'Excel : 2003 FR

Message par Klin89 » 2 décembre 2018, 00:29

Re ::o

Ça serait plutôt ce genre d'empillage ::~
Vu qu'il y a des doublons dans la première colonne.
Option Explicit
Sub test()
Dim a, i As Long, j As Long, dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    a = Sheets("2010").Range("a1").CurrentRegion.Value2
    For i = 2 To UBound(a, 1)
        If Not dico.exists(a(i, 1)) Then
            Set dico(a(i, 1)) = CreateObject("Scripting.Dictionary")
            dico(a(i, 1)).CompareMode = 1
        End If
        Set dico(a(i, 1))(a(i, 3)) = CreateObject("Scripting.Dictionary")
        dico(a(i, 1))(a(i, 3)).CompareMode = 1
        For j = 2 To UBound(a, 2)
            dico(a(i, 1))(a(i, 3))(a(1, j)) = a(i, j)    '<--- la valeur associee
        Next
    Next
    Set dico = Nothing
End Sub
klin89
Modifié en dernier par Klin89 le 2 décembre 2018, 15:36, modifié 1 fois.
Avatar du membre
Jean-Eric
Fanatique d'Excel
Fanatique d'Excel
Messages : 14'969
Appréciations reçues : 465
Inscrit le : 27 août 2012
Version d'Excel : O365 32 bits

Message par Jean-Eric » 2 décembre 2018, 07:40

Bonjour,
Tu disposes d'Excel 2016 donc de Power Query (Récupérer et transformer).
Tu dois pouvoir traiter tes données sans réelles difficultés.
Lien :
https://support.office.com/fr-fr/articl ... F6269CD605
Jean-Eric

Je ne réponds pas aux M.P. non sollicités.
Avatar du membre
Klin89
Membre dévoué
Membre dévoué
Messages : 596
Appréciations reçues : 21
Inscrit le : 28 mai 2011
Version d'Excel : 2003 FR

Message par Klin89 » 2 décembre 2018, 09:36

Re Alexandre74006,
Salut Jean-Eric :)

Comme l'avait souligné MFerrand précédemment, tout simplement ::B.
Option Explicit
Sub test()
Dim a, b, i As Long, j As Long, dico As Object, txt As String, ws As Worksheet
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    For Each ws In Worksheets
        a = ws.Range("A1").CurrentRegion.Value2
        For i = 2 To UBound(a, 1)
            For j = 2 To UBound(a, 2)
                txt = Join$(Array(ws.Name, a(i, 1), a(i, 3), a(1, j)), "|")
                dico(txt) = a(i, j)
            Next
        Next
    Next
    txt = "2010|HAFC UW Equity|SML|Secteur GICS"
    If dico.exists(txt) Then
        b = dico(txt)
    End If
    Set dico = Nothing
End Sub
klin89
A
Alexandre74006
Jeune membre
Jeune membre
Messages : 20
Inscrit le : 27 novembre 2018
Version d'Excel : 2016 FR

Message par Alexandre74006 » 2 décembre 2018, 20:11

Merci infiniment pour vos réponses !

Alexandre74006
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message