Création, Analyse et Gestion d'une base de données via dictionnaires [VBA]

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

104data.xlsx (476.00 Ko)

Bonsoir à tous,

Alexandre74006 : une simple formule avec Index Match devrait suffire non

Sinon pour t'aider

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

klin89

Re

Ç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

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/article/Présentation-de-Microsoft-Power-Query-pour-Excel-6E92E2F4-2079-4E1F-BAD5-89F6269CD605

Re Alexandre74006,

Salut Jean-Eric

Comme l'avait souligné MFerrand précédemment, tout simplement

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

Merci infiniment pour vos réponses !

Alexandre74006

Rechercher des sujets similaires à "creation analyse gestion base donnees via dictionnaires vba"