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
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 :
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