Pb restitution Scripting Dictionnary (~ sommeprod avec corridor date et valeur)

[zebanx]

Bonjour à tous,

J'utilise un fichier avec beaucoup de sommeprod sur plusieurs lignes / plusieurs colonnes et une base de données assez conséquente (disons 40000 lignes sur une dizaine de colonne).
Cela fonctionne bien mais sommeprod sur une grosse base signifie un code qui tourne parfois un peu lentement.

Je souhaiterai faciliter un peu le tout en utilisant et en adaptant un peu un super code de Scripting Dictionnary (Hello à Laetitia90), épuré et efficace, avec un cas très "édulcoré" :
cas 1 : une utilisation simple de sommeprod
cas 2 : utilisation renforcée de sommeprod (contrainte de dates max / min et rajout d'une valeur min / max à respectée).

Il y a malheureusement un problème de restitution dans le cas 1 (clé = ok mais ce sont les items qui posent problème).
Et pour le cas 2, je ne sais pas quels bouts de codes utiliser (if..., while...) et où les placer par rapport à ce code.

Si vous pouvez me communiquer vos commentaires, remarques, je vous en remercie par avance.

Bonne journée,
zebanx

 

[zebanx]

Je viens de me rendre compte d'une erreur dans mon code.

Je vais reformuler ma demande pour le deuxième point.

Veuillez m'en excuser et particulièrement à Laetitia dont j'ai mal repris une variable dans le code

 

[job75]

Bonjour zebanx,

Le calcul prend inutilement du temps parce que chaque SOMMEPROD étudie les 4 colonnes M1 M2 M3 M4 donc au total 6 colonnes du tableau source.

Avec cette formule en L2 il n'y a que 3 colonnes étudiées, le calcul prendra 2 fois moins de temps :

=SOMMEPROD(($J2=$A$2:$A$12)*($K2=$C$2:$C$12);D$2:D$12)

A+

 

[zebanx]

Bonjour et merci @ Job75 pour cette remarque -)

Je vais donc regarder sur le tableau sur toutes les formules qui contiennent des sommeprod déjà.
Le sujet #1 restera peut-être d'actualité sur le cas 2 (adaptation du code dictionnaire à ~ sommeprod avec contraintes de dates, min et max) mais je vais chercher au préalable et de toute manière remettre à plat ce fichier.
Encore désolé pour avoir posté inutilement tout à l'heure.

++
zebanx

 

[gosselien]

Bonjour,

Avec 40.000 lignes ton sommeprod va ralentir le pc ...
La solution du dico est certainement plus rapide, mais pour le moment j'ignore comment restituer les colonnes sans celle des dates...
Beau problème
P.
ps: avec ta zone tableau du bas nommée "tblo", arrive à remettre les colonnes sans les dates mais ici pas de dico, il faut donc voir comment mettre le dico dans un tableau mémoire et puis restituer comme cela.

Sub tes()
A = [A1:G12].Value
[tblo].ClearContents
Dim tmp(): ReDim tmp(1 To UBound(A), 1 To 1): For i = 1 To UBound(A): tmp(i, 1) = i: Next
B = Application.Index(A, tmp, Array(1, 3, 4, 5, 6, 7))
[J10].Resize(UBound(B), UBound(B, 2)) = B
End Sub

JB en parle sur son excellent site rubrique dictionnaire
http://boisgontierjacques.free.fr/

 

[zebanx]

Merci Gosselien.

Merci pour ton retour.
Ton index fonctionne bien en tout cas et j'irai voir sur le site de JB.

Par rapport au code de Laetitia, après la partie de constitution du tableau (ie : "x" valeurs en Rows constitués), je suis reparti sur une boucle et je restitue sur 6 colonnes au final.
Ca a l'air de fonctionner comme ça avant simplification.

++
zebanx

Avant : première partie du code de Laetitia sur la constitution du SD (t)
-----
For z = 1 To x  '-- x étant le nombre de rows finales du tableau t
For c = 1 To 1
t(z, c) = t(z, c)
Next c
For c = 3 To 7
e = c - 1
t(z, e) = t(z, c)
Next c
Next z
'--- restitution finale
[J10].Resize(x, 6) = t

 

[zebanx]

Re-

@job75 : il n'y avait qu'une colonne comprenant une plage plus longue. Ceci a toutefois permis de diminuer un peu le temps d'exécution comme tu me l'avais indiqué (#3) (merci)

------------------
edit #1 et #2
Ci-joint le fichier amendé.
Le code de Laetitia90 fonctionne parfaitement avec une sommeprod. sans contrainte de type "<" ou ">".

Je n'arrive pas à traiter l'intégration de ces dernières dans les "corridor"(valeur min / valeur max) dans le code (feuille 2) :
- dates
- valeurs recherchées

Il pourrait s'agir de if t(i,1)>= range("S2".value)... mais je ne sais pas où les placer dans le code.
Et peut-être même faudrait-il utiliser une boucle do while...

Si vous avez des idées, merci beaucoup !

Bonne soirée
zebanx

 

[job75]

Bonjour zebanx, le forum,

La bonne formule en L2 :

=SOMMEPROD(($J2=$A$2:$A$15)*($K2=$C$2:$C$15)*($B$2:$B$15>=$S$2)*($B$2:$B$15<=$T$2)*(D$2:D$15>=$U$2)*(D$2:D$15<=$V$2);D$2:D$15)

Bonne journée.

 

[job75]

Re,

Et maintenant la bonne macro :

Sub Somme()
Dim datmin, datmax, mini, maxi, t, resu(), d As Object, i&, x$, lig&, j%, n&
datmin = [S2]: datmax = [T2]: mini = [U2]: maxi = [V2]
t = [A1].CurrentRegion.Resize(, 7).Offset(1)
ReDim resu(1 To UBound(t), 1 To 6)
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For i = 1 To UBound(t) - 1
    If t(i, 2) >= datmin And t(i, 2) <= datmax Then
        x = Trim(t(i, 1)) & Trim(t(i, 3))
        If d.exists(x) Then
            lig = d(x)
            For j = 4 To 7
                If t(i, j) >= mini And t(i, j) <= maxi Then resu(lig, j - 1) = resu(lig, j - 1) + t(i, j)
            Next j
         Else
            n = n + 1
            d(x) = n 'mémorise la ligne
            resu(n, 1) = t(i, 1): resu(n, 2) = t(i, 3)
            For j = 4 To 7
                resu(n, j - 1) = IIf(t(i, j) >= mini And t(i, j) <= maxi, t(i, j), 0)
            Next j
        End If
    End If
Next i
'---restitution---
With [J12].Resize(n + 1, 6)
    .Value = resu
    .Offset(n).Resize(Rows.Count - n - .Row + 1).Delete xlUp
End With
End Sub

A+

 

[zebanx]

Super !
Merci Job75 pour ce code et l'avoir fait, comme toujours (!), si rapidement.

J'avais repris hier le code et avancer correctement sur la contrainte de date mais pas encore celle de valeur. Et je suis content d'avoir ce code là, finalisé, qui complète bien le super code original avec cette contrainte de double boucle supplémentaire traitée par des "if", ce qui est préférable (pour moi) à une boucle while... (peu utilisée dans mes bouts de code).
(Au boulot maintenant de mon côté!).

Bonne journée
zebanx

 

[job75]

Re,

Pour éviter un bug quand n = 0 (tableau des résultats vide) j'ai tout simplement remplacé :

With [J12].Resize(n, 6)

par :

With [J12].Resize(n + 1, 6)

A+

 

[job75]

Re,

Pour finir, quand le tableau des résultats diminue de hauteur, ceci est agréable :

'---restitution---
With [J12].Resize(n + 1, 6)
    .Value = resu
    .Offset(n).Resize(Rows.Count - n - .Row + 1).Delete xlUp
    With .Parent.UsedRange: End With 'actualise la barre de défilement verticale
End With

A+

 

[zebanx]

Merci JOB75 pour ces précisions. Je suis preneur de ces astuces et tu y es l'un des plus attentif, c'est vraiment sympa.
Bien vu le #11 notamment (le 12 est connu --))
J'ai pas eu le temps de finaliser mon fichier, c'est assez long à faire parce qu'il y a plusieurs sommeprod., il faut donc rebalayer un peu tout ça...( et de toute manière, avec le code du #9, j'aurais gagné un très bon code!)

 

[job75]

Bonjour zebanx,

Je repasse par ici car je me suis aperçu que ma restitution n'était pas fameuse, utiliser :

'---restitution---
With [J12]
    .Resize(n + 1, 6) = resu
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 6).Delete xlUp
End With
With ActiveSheet.UsedRange: End With 'actualise la barre de défilement verticale

A+