Dico pour remplacer sommeprod
Bonjour,
dans mon fichier ci annexé, je dois compter un nombre de dossiers pour base de données et ensuite un nombre de club par activité sportive; par formule, ça ne pose par de problème mais malgré un pc tout récent et 24Mg de ram, c'est très lent.
Mes colonnes N et O sont donc correcte mais la formule en colonne N devrait être remplacée par un code vba que je ne sais pas faire.
La formule pour mon nombre de dossier est refaite en vba, OK (voir les colonnes R et S) .
Je cherche à présent à faire la même chose pour ma colonne N que vous verrez sur ma feuille.
Je tiens à faire ceci en VBA pour la raison de lenteur évoquée plus haut.
Y-a-t-il une personne ici qui pourrait me dire comment faire en VBA et si possible avec dico pour ma culture générale des dico pour accélérer le processus; on imagine cette formule avec 15.000 lignes ...
Merci !!!
Patrick
Bonjour Patrick,
Une solution par dico comme souhaitée. On traite en plus les plages de données dans des variables tableau pour accélerer le traitement.
1/2 s pour environ 30000 lignes chez moi.
J'ai commenté le code pour éclaircir.
Sub NbClubs()
Dim derlign As Long, i As Long
Dim tblBenef, tblDiscipline
Dim dicoBenef As Object, dicoDiscipline As Object
Dim t
t = Timer
'désactive la mise à jour de l'écran
Application.ScreenUpdating = False
'dernière ligne
derlign = Range("A" & Rows.Count).End(xlUp).Row
'met les données dans des variables tableau pour traitement plus rapide
tblBenef = Range("D6:D" & derlign).Value2
tblDiscipline = Range("H6:H" & derlign).Value2
Set dicoBenef = CreateObject("Scripting.Dictionary")
Set dicoDiscipline = CreateObject("Scripting.Dictionary")
'ignore la casse des clés de dico
dicoBenef.CompareMode = vbTextCompare
dicoDiscipline.CompareMode = vbTextCompare
dicoDiscipline(tblDiscipline(LBound(tblDiscipline), 1)) = "Nb dossiers"
For i = LBound(tblDiscipline) + 1 To UBound(tblDiscipline)
'si la discipline n'existe pas, on l'ajoute en initialisant les compteurs à 0
If Not dicoDiscipline.exists(tblDiscipline(i, 1)) Then dicoDiscipline(tblDiscipline(i, 1)) = 0
'on regarde si le bénéficiaire existe déjà dans notre dico
's'il n'existe pas, on l'ajoute et on incrémente
's'il existe déjà, cela signifie qu'on l'a déjà ajouté une fois au dico. On passe
If Not dicoBenef.exists(tblBenef(i, 1) & "$" & tblDiscipline(i, 1)) Then
'on ajoute le bénéficiaire au dico des bénéficiaires
dicoBenef(tblBenef(i, 1) & "$" & tblDiscipline(i, 1)) = 0
'on incrémente la discipline de 1
dicoDiscipline(tblDiscipline(i, 1)) = dicoDiscipline(tblDiscipline(i, 1)) + 1
End If
Next i
'liste des disciplines (a priori pas besoin de les coller car déjà fait lors du compte des dossiers)
'Range("R7").Resize(dicoDiscipline.Count) = Application.Transpose(dicoDiscipline.keys)
'nb de dossiers par discipline
Range("T6:T" & derlign).ClearContents
Range("T6").Resize(dicoDiscipline.Count).Value2 = Application.Transpose(dicoDiscipline.items)
'vide les dicos de la mémoire
Set dicoBenef = Nothing
Set dicoDiscipline = Nothing
MsgBox "Temps de traitement (en s) : " & Timer - t
End Sub
Edit : Code réadapté pour tenir compte des cas où plusieurs disciplines pour 1 même bénéficiaire.
Bonjour vba-new et le forum,
Merci !!!! pour le code et les explications.
Je t'ai envoyé un MP pour une petite question si tu veux bien
Patrick
re,
Peux-tu me dire alors ce qui se passe ici ?
J'ai des #N/A en bout de colonnes
Merci
Option Explicit
Sub NbClubs() ' 02/2016
Dim F1 As Worksheet
Dim Dico, Dico2
Dim A, B, C
Dim Temp
Set F1 = Sheets("feuil1")
Set Dico = CreateObject("Scripting.Dictionary")
Set Dico2 = CreateObject("Scripting.Dictionary")
For Each C In F1.[DISCIPLINE__SPORTIVE] ' zone nommée pour plus clarté
Temp = C.Value & C.Offset(, -4)
If Not Dico.Exists(Temp) Then
Dico(Temp) = Dico(Temp) & Temp
Dico2(C.Value) = Dico2(C.Value) + 1
End If
Next C
A = Dico.keys
B = Dico.items
[t6].Resize(Dico.Count, 1) = Application.Transpose(Dico2.items)
End Sub
Sub NbDossiers() ' OK 02/2016
Dim F1 As Worksheet
Dim Dico, Dico2
Dim A, B, C
Dim Temp
Set F1 = Sheets("feuil1")
Set Dico = CreateObject("Scripting.Dictionary")
Set Dico2 = CreateObject("Scripting.Dictionary")
For Each C In F1.[DISCIPLINE__SPORTIVE]
Temp = C.Value & "¦" & C.Offset(, -4)
Dico(Temp) = IIf(Dico.Exists(Temp), Dico(Temp) + 1, 1)
Dico2(C.Value) = Dico2(C.Value) + 1
Next C
A = Dico.keys
B = Dico.items
[q:v].ClearContents
[R6].Resize(Dico.Count, 1) = Application.Transpose(Dico2.keys)
[S6].Resize(Dico.Count, 1) = Application.Transpose(Dico2.items)
End Sub
Le problème venait de là :
[t6].Resize(Dico.Count, 1) = Application.Transpose(Dico2.items)
C'est mieux comme ça :
[t6].Resize(Dico2.Count, 1) = Application.Transpose(Dico2.items)
Ta plage cible doit être redimensionnée à la même taille que ta plage source.
Si ta plage cible est plus grande que la plage source, la différence sera remplie avec des #NA car ton Dico2 contient moins d'éléments que Dico.
Je ne sais pas si je suis clair
Mes commentaires pour la première procédure :
Sub NbClubs() ' 02/2016
Dim F1 As Worksheet
Dim Dico As Object, Dico2 As Object '<-- être le plus précis possible dans la déclaration des variables afin de ne pas utiliser de la mémoire pour rien
'Dim A, B, C '<-- inutile, pas utilisé
Dim Temp As String '<-- même remarque que plus haut
Set F1 = Sheets("feuil1")
Set Dico = CreateObject("Scripting.Dictionary")
Set Dico2 = CreateObject("Scripting.Dictionary")
'parcours de toutes les cellules de la plage
For Each C In F1.[DISCIPLINE__SPORTIVE] ' zone nommée pour plus clarté
Temp = C.value & C.Offset(, -4)
If Not Dico.Exists(Temp) Then
Dico(Temp) = Temp
Dico2(C.value) = Dico2(C.value) + 1
End If
Next C
'A = Dico.keys '<-- inutile, pas utilisé
'B = Dico.items '<-- inutile, pas utilisé
'le resize est faux
'Dico.Count comptait plus d'éléments que Dico2
'ex : si Dico.Count=10 mais Dico2.Count=4, les 6 éléments restants sont remplis avec des #NA
'[t6].Resize(Dico.Count, 1) = Application.Transpose(Dico2.items)
[t7].Resize(Dico2.Count, 1) = Application.Transpose(Dico2.items)
'par principe, on vide les dicos de la mémoire
Set Dico = Nothing
Set Dico2 = Nothing
End Sub
Mise à part la déclaration non optimale des variables et l'erreur de taille de dico lors de l'écriture des données dans la feuille, ta première procédure marche bien ! Elle marche même mieux que la mienne car je n'avais pas compris qu'un même bénéficiaire pouvait avoir plusieurs disciplines (j'ai édité mon message précédent pour corriger la macro).
Super !!
Un grand merci pour tes explications !
Je vais tenter d'appliquer ce que tu as écris
Patrick
re vba-new et le forum,
tu auras compris pourquoi je cherchais à faire un code VBA (en partie réussi tout seul, ouf ) car la formule que j'utilisais
=SOMMEPROD((1/NB.SI(BÉNÉFICIAIRE;BÉNÉFICIAIRE)*(Discipline__sportive=M7))) qui est une (matricielle bien sur
prenait un temps de racalcul fou ( DELL tout neuf et 24 Mg de Ram pourtant).
Si la demande qui m'a été faite par ma compagne dans ce fichier revient régulièrement, je vais adapter le code pour y ajouter comme dans mon exemple la réponse à la droite du tableau de base et pourquoi pas demander sur quelles colonnes de la base il faut faire ce genre de travail.
P.