XL 2016 Formules matricielles max si deux conditions en VBA

[safranien]

Bonjour et meilleurs à toutes et tous
je vous sollicite car je n'arrive pas à retranscrire des formules matricielles en VBA. Je dispose d'un fichier de travail assez lourd et plein de calculs que j'ai réussi à optimiser relativement bien via VBA (ce fichier est en mode de calcul manuel). En PJ, un extrait de ce fichier pour la partie que je n'arrive pas à traiter. Dans les colonnes T à X, les formules matricielles max si à 2 conditions que j'utilise. Rien que pour cette partie, le temps de calcul est très long et vient donc allonger les temps de traitement de mon fichier de travail. J'espérais réussir à transposer ces formules en VBA pour que ce soit plus rapide, j'ai bien réussi à écrire qqch mais le temps de calcul est encore plus long.
Le rendu de la macro se fait dans le tableau dans les colonnes L à P.
Pourriez-vous m'aider pour que ces calculs puissent se faire beaucoup plus rapidement via VBA ?
En vous remerciant et bon week-end.

 

[job75]

Bonsoir safranien,

Voyez le fichier joint et la macro affectée au bouton :

Sub Maximum()
Dim F As Worksheet, d As Object, dd As Object, tablo, ncol%, i&, x$, n&, resu(), a, j%, dat, nn&, col%
Set F = Sheets("Feuil1") 'nom de la feuille à adapter
Set d = CreateObject("Scripting.Dictionary")
Set dd = CreateObject("Scripting.Dictionary")
tablo = F.[B14].CurrentRegion.Resize(, 9) 'matrice, plus rapide
'---liste des  en-têtes de colonnes---
ncol = 1
For i = 2 To UBound(tablo)
    x = tablo(i, 9)
    If x <> "" Then If Not d.exists(x) Then ncol = ncol + 1: d(x) = ncol
Next i
'---tableau des résultats---
n = 1
ReDim resu(1 To ncol, 1 To 1) 'tableau transposé
resu(1, 1) = tablo(1, 2) 'titre Date
a = d.keys
For j = 2 To ncol: resu(j, 1) = a(j - 2): Next j 'titres
For i = 2 To UBound(tablo)
    dat = tablo(i, 2)
    If Not dd.exists(dat) Then
        n = n + 1
        dd(dat) = n 'mémorise le numéro
        ReDim Preserve resu(1 To ncol, 1 To n)
        resu(1, n) = dat
    End If
    nn = dd(dat)
    col = d(tablo(i, 9))
    If col And IsNumeric(tablo(i, 1)) Then If CDbl(tablo(i, 1)) > resu(col, nn) Then resu(col, nn) = CDbl(tablo(i, 1))
Next i
'---transposition des résultats---
ReDim a(1 To n, 1 To ncol)
For i = 1 To n
    For j = 1 To ncol
        a(i, j) = resu(j, i)
Next j, i
'---restitution sur L14 (cellule à adapter)---
Application.ScreenUpdating = False
If F.FilterMode Then F.ShowAllData 'si la feuille est filtrée
F.[L14].CurrentRegion.Delete xlUp 'RAZ
With F.[L14].Resize(n, ncol)
    .Value = a
    .Borders.Weight = xlThin 'bordures
    .Interior.Color = RGB(221, 235, 247) 'bleu
End With
End Sub

Elle est très rapide car elle utilise des tableaux VBA et 2 Dictionary.

PS : je n'ai conservé que les valeurs des colonnes T:Y afin de comparer les résultats.

Bonne nuit.

 

[job75]

Bonjour safranien, le forum,

Comme la macro est très rapide on peut remplacer le bouton par une macro évènementielle :

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False 'désactive les évènements
Maximum 'lance la macro
Application.EnableEvents = True 'réactive les évènements
End Sub

Fichier (2), testée sur 150 000 lignes la macro s'exécute chez moi en 0,9 seconde.

A+

 

[safranien]

Bonjour Job75

waouh merci beaucoup pour ton retour et ta proposition. Je reste toujours admiratif de ce que vous réussissez à rédiger. Je suis plus que débutant et j'avoue avoir du mal à tout bien comprendre dans le code. Je n'arrive déjà pas à comprendre à quel moment se font les calculs...

J'ai essayé de modifier car il y a quelques éléments dans le rendu qui ne vont pas avec ce que je cherche à faire, mais je n'y arrive pas, à savoir :
_ la colonne de date qui est en colonne S n'a pas besoin d'être remise avec le résultat en colonne L. J'utilise cette colonne S pour d'autres choses et techniquement, dans mon fichier de travail, je ne peux pas mettre cette colonne là où tu l'as mises et j'ai besoin des 365 jours suivant la 1er date et pas juste les jours où il y a de la donnée.
_ j'ai besoin des 0 dans les cellules où il n'y a pas de valeurs plutôt que des cellules vides
_ mon tableau devant accueillir les résultats n'a pas besoin d'être effacé ni mis en forme. Dans mon fichier de travail, toute la plage, de L14 à P380 (réf de mon fichier) est déjà mise en forme et ma ligne de titre ne change pas. J'ai juste besoin que les valeurs issues des caculs viennent s'inscrirent au bon endroit.
_ après exécution de la macro, l'ordre des colonnes et des résultats est inversé : on a HCH / HPH / P / HCE / HPE : le bon ordre est comme celui du tableau exemple à savoir P / HPH / HCH / HPE / HCE
_ s'agissant d'un extrait de mon fichier de travail, il y a plein de données autour de ces éléments. Si je comprends bien F.[L14].CurrentRegion.Delete xlUp, cela veut dire que ça efface tout ce qu'il y a dans la colonne L entièrement c'est ça ? Si oui, c'est pas une bonne idée. Etant donné que je n'ai pas besoin de cette colonne date, on ne pourrait effacer que les cellules devant accueillir les valeurs, c'est à dire de L15 à P380 (les références sont celles de mon fichier, pas de ta version car en ayant ajouté la colonnes dates, ca décalle les zones).

Est ce possible de faire ces quelques corrections stp ?

 

[job75]

Bon voyez ce fichier (3) et la macro :

Sub Maximum()
Dim F As Worksheet, dest As Range, d As Object, dd As Object, tablo, ncol%, j%, i&, dat, n&, resu(), nn&, col%, a()
Set F = Sheets("Feuil1") 'nom de la feuille à adapter
Set dest = F.[L14:Q14] 'ligne des en-têtes, à adapter
Set d = CreateObject("Scripting.Dictionary")
Set dd = CreateObject("Scripting.Dictionary")
tablo = F.[B14].CurrentRegion.Resize(, 9) 'matrice, plus rapide
'---liste des  en-têtes de colonnes---
With dest
    ncol = .Columns.Count
    For j = 2 To ncol
        d(.Cells(j).Value) = j 'repère le numéro de colonne
    Next j
End With
'---tableau des résultats---
For i = 2 To UBound(tablo)
    dat = tablo(i, 2)
    If Not dd.exists(dat) Then
        n = n + 1
        dd(dat) = n 'mémorise le numéro
        ReDim Preserve resu(1 To ncol, 1 To n)
        resu(1, n) = dat
    End If
    nn = dd(dat)
    col = d(tablo(i, 9))
    If col And IsNumeric(tablo(i, 1)) Then If CDbl(tablo(i, 1)) > resu(col, nn) Then resu(col, nn) = CDbl(tablo(i, 1))
Next i
If n = 0 Then Exit Sub
'---transposition des résultats---
ReDim a(1 To n, 1 To ncol)
For i = 1 To n
    For j = 1 To ncol
        a(i, j) = resu(j, i)
Next j, i
'---restitution---
Application.ScreenUpdating = False
If F.FilterMode Then F.ShowAllData 'si la feuille est filtrée
With dest.Offset(1).Resize(n)
    .Value = a
    .Replace "", 0
End With
End Sub

La colonne des dates est indispensable sinon le tableau des résultats n'aurait aucun sens.

Et ne pas effacer le tableau avant restitution n'est pas très astucieux si l'on modifie le tableau source.

 

[safranien]

super, merci. On y est presque.
Il demeure un point, c'est à dire que je n'ai pas besoin des dates que vous avez ajoutées en colonne L. Sur la base de mon fichier d'origine, en fait, j'ai besoin que les résultats des calculs issus du code viennent s'inscrire dans la plage L15 jusqu'à la dernière date contenant des données dans la colonne B, soit, dans notre exemple jusqu'en P119 pour le 21/04.

Trois dernières questions si vous me le permettez :
_ est-ce que les calculs se font à la volée où y a-t-il une sorte de zone tampon utilisée qque part dans la feuille ? Si c'est le cas, ou cela se retrouve-t-il ? En effet, cela pourrait effacer des autres données dans mon fichier de travail ?
_ dans le code, où dois-je modifier si je veux changer la destination des résultats ?
_ je cherche toujours à comprendre ce que proposent tous les contributeurs et chacun ayant son style de codage, je ne m'y retrouve pas toujours. Sans vouloir abuser, pensez vous pouvoir me détailler ce que fait chaque ligne en commentaire ? Je n'arrive par exemple même pas à comprendre à quel endroit se font les calculs équivalents à la formule matricielle Si je peux mieux comprendre, je pourrai modifier si besoin et aurai moins / n'aurai plus besoin de vous embêter.

 

[job75]

Il n'y a pas de zone "tampon", tout se passe dans des tableaux VBA.

Le code est clair et il y a assez de commentaires, il suffit de lire.

 

[safranien]

oui, pour vous il est clair c'est certain mais pour un débutant pas forcément. Mais ok, je vais tâtonner et essayer de trouver maintenant comment ne plus avoir cette colonne de dates que vous avez ajoutée et dont je n'avais pas besoin.
Merci pour votre aide. Bonne journée.

 

[job75]

La colonne des dates est indispensable, comme je l'ai dit.

Maintenant vous ne comprendrez rien si vous n'apprenez pas ce qu'est un Dictionary.

Renseignez-vous, je ne vais pas vous l'apprendre.

 

[safranien]

OK mais comme il y a déjà une colonne de date je ne comprends pas pourquoi ne pas utiliser celle ci plutôt que d'en créer une autre. Vous constaterez bien que les dates de votre colonne sont les mêmes que celles de ma colonne. Le tableau des résultats est positionné en correspondance avec ma colonne de dates. C'est pourquoi j'ai laissé en exemple mon tableau de résultat actuel avec les formules couplé à la colonne de dates et la demande ben c'est juste de pouvoir remplacer les calculs par formules matricelles par du VBA tout en conservant la structure existante. Si malgré tout elle est obligatoire, dans ce cas il faut que je trouve comme la mettre ailleurs dans ma feuille et l'effacer ensuite une fois les résultats inscrits, parce que dans mon fichier de travail, je ne peux pas ajouter cette nouvelle colonne de date à cet endroit là, la place est occupée pour plein d'autres choses.

 

[job75]

Visiblement vous n'avez pas compris que le tableau source peut être modifié.

Et que des dates peuvent y être ajoutées ou supprimées !!!

Votre tableau de droite (colonnes T:Y) est totalement inutile et doit être supprimé.

Un seul tableau de résultats doit être créé.

J'ai bien l'impression que votre fichier réel ne tient pas la route.

 

[safranien]

Effectivement, je ne sais pas encore ce que fait Dictionnary et je ne vous demande pas de me l'apprendre mais c'est déjà une bonne piste de compréhension pour moi.

Mon tableau de droite est inutile effectivement puisqu'il s'agit de l'exemple des valeurs qui sont calculées avec les formules matricielles.
J'ai bien compris que le tableau source pouvait être modifié puisque c'est moi qui l'ai créé et qui le mets à jour. A partir de ce tableau source, je bâtis la colonne date, la première date correspondant au 1er jour du tableau source puis j'ajoute +1 dans les cellules suivantes pour avoir une colonne avec 365 ou 366 jours.

Cependant, et pour rappel :
1) il s'agit d'un extrait de mon fichier de travail et de ce fait, je ne peux pas déplacer les colonnes existantes comme je veux (je l'ai précisé)
2) ma colonne de date doit rester en colonne S (je l'ai précisé)
3) dans ma colonne de dates, j'ai 365 ou 366 jours. C'est voulu et nécessaire pour moi là où vous ajoutez une colonne et arrêtez les dates de cette dernière à la dernière date où il y a des valeurs en colonne B (ce qui n'était pas demandé)

Mon fichier tient très bien la route, dans le sens où j'ai d'autres données qui sont liées à cette colonne de dates et il n'est écrit nulle part que la colonne date doit forcément être collée à gauche du tableau de résultats. En PJ, extrait de mon fichier de travail et j'ai entouré en rouge ce que j'ai extrait pour faire le fichier envoyé. J'ai fait au mieux pour transmettre un fichier exemple calé selon les mêmes dispositions que mon fichier de travail, justement pour éviter de multiples messages en disant "ah au fait, le résultat il me le faudrait plutôt en telle colonne etc" mais même comme ça je n'ai pas réussi à être assez explicite manifestement.

Bref, laissez tomber. Je ne vais pas nous faire perdre plus de temps ni modifier mon fichier de travail juste parce qu'il ne vous semble pas possible d'inscrire les valeurs correspondant aux résultats de mes calculs de formules matricielles sous forme VBA dans le tableau de résultats sans changer tout le reste autour ni ajouter une autre colonne de dates.

Merci quand même pour votre aide je vais creuser votre proposition ou attendre de voir si quelqu'un d'autre a une autre idée de faire.

Bonne journée

 

[job75]

Vous vouliez un code VBA pour aller vite, je vous l'ai donné avec plusieurs solutions.

A vous de l'adapter à votre fichier réel.

 

[safranien]

je demandais un code VBA pour accélérer la vitesse de calcul en remplacement des formules matricielles, POINT, pas des ajouts de colonnes etc qui ne me servent pas et avec lesquels maintenant vous me dites de me débrouiller avec ça sachant que je suis plus que novice en VBA.

Soit on reproche aux demandeurs de ne pas être assez précis dans leur demande et quand la demande est précise, vous ajoutez des choses qui ne sont pas demandées et après on doit se débrouiller. C'est vraiment bizarre comme façon de faire.

Mais oui, je vais l'adapter à mon fichier. Je finirai bien par trouver quelqu'un disposé à m'aider à comprendre comment modifier le code de quelqu'un d'autre pour qu'il réponde à mon besoin !

Bonne journée

 

[job75]

en remplacement des formules matricielles, POINT, pas des ajouts de colonnes etc

Le tableau que j'ai créé correspond EXACTEMENT au tableau de vos formules matricielles du post #1.

Je n'ai ajouté aucune colonne.