XL 2016 Formules matricielles max si deux conditions en VBA

safranien

XLDnaute Occasionnel
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.
 

Pièces jointes

  • max si 2 conditions en vba.xlsm
    632.7 KB · Affichages: 22

mapomme

XLDnaute Barbatruc
Supporter XLD
Re,

Une version v4a qui devrait (si j'ai bien tout saisi) correspondre à ce que souhaitez.

j'ai repris ma méthode des "dictionary" (quitte à tout réécrire autant prendre la plus rapide - cependant cette méthode ne fonctionne pas sur les machines de la pomme -> Apple)
  • une batterie de constantes en début de programme permet une petite adaptation notamment où afficher les résultats
  • on ne touche ni aux en-têtes ni aux formats de la zone résultat en colonnes L à P
  • il y a un doublon de date dans la colonne S. Dans ce cas, on n'affiche les résultats que sur la ligne de la première occurrence. Les autres lignes avec la même date restent à zéro. A la fin de l'exécution, on affiche les dates en doublons.
J'ai modérément contrôlé les résultats. A vous de le faire de manière plus approfondie ;)

edit: bonjour @job75 :)
 

Pièces jointes

  • safranien- max si 2 conditions en vba-v4a.xlsm
    380.3 KB · Affichages: 12
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour safranien, mapomme, le forum,

Bon d'accord si la colonne des dates (S) est remplie à l'avance c'est finalement plus simple, fichier (6) :
VB:
Sub Maximum()
Dim F As Worksheet, dest As Range, ncol%, d As Object, dd As Object, tablo, derlig&, dates, resu(), j%, i&, lig&, col%
Set F = Sheets("Feuil1") 'nom de la feuille à adapter
Set dest = [L14:P14] 'en-têtes de la plage de destination, à adapter
ncol = dest.Columns.Count
Set d = CreateObject("Scripting.Dictionary")
Set dd = CreateObject("Scripting.Dictionary")
tablo = F.[B14].CurrentRegion.Resize(, 9) 'matrice, plus rapide
If F.FilterMode Then F.ShowAllData 'si la feuille est filtrée
derlig = F.Range("S" & F.Rows.Count).End(xlUp).Row
dates = F.Range("S14:T" & derlig) 'matrice, plus rapide, au moins 2 éléments
ReDim resu(1 To UBound(dates), 1 To ncol)
'---liste des  en-têtes de colonnes---
For j = 1 To ncol
    d(dest(j).Value) = j 'mémorise le numéro de colonne
    resu(1, j) = dest(j)
Next j
'---liste des dates---
For i = 2 To UBound(dates)
    dd(dates(i, 1)) = i 'mémorise le numéro de ligne
Next i
'---tableau des résultats---
For i = 2 To UBound(tablo)
    col = d(tablo(i, 9))
    lig = dd(tablo(i, 2))
    If col > 0 And lig > 0 And IsNumeric(tablo(i, 1)) Then If CDbl(tablo(i, 1)) > resu(lig, col) Then resu(lig, col) = CDbl(tablo(i, 1))
Next i
'---restitution---
With dest.Resize(UBound(resu))
    .Value = resu
    .Replace "", 0
End With
End Sub
Mais ça manque quand même de cohérence (il peut y avoir des erreurs en colonne S).

A+
 

Pièces jointes

  • max si 2 conditions en vba(6).xlsm
    601.2 KB · Affichages: 11

safranien

XLDnaute Occasionnel
Merci mapomme !
Faut vraiment que je comprenne cette méthode des Dictionnary. Je m'y penche dès que je peux.
Tout fonctionne dans le fichier test. Mais si j'inclue le code dans mon fichier de travail, j'ai cette erreur :
1641817868764.png

Une idée de ce qui peut provoquer cela ? Est-ce que cela change beaucoup si je mets ce code dans un module plutôt qu'une feuille ?
 

safranien

XLDnaute Occasionnel
Bonjour safranien, mapomme, le forum,

Bon d'accord si la colonne des dates (S) est remplie à l'avance c'est finalement plus simple, fichier (6) :
VB:
Sub Maximum()
Dim F As Worksheet, dest As Range, ncol%, d As Object, dd As Object, tablo, derlig&, dates, resu(), j%, i&, lig&, col%
Set F = Sheets("Feuil1") 'nom de la feuille à adapter
Set dest = [L14:P14] 'en-têtes de la plage de destination, à adapter
ncol = dest.Columns.Count
Set d = CreateObject("Scripting.Dictionary")
Set dd = CreateObject("Scripting.Dictionary")
tablo = F.[B14].CurrentRegion.Resize(, 9) 'matrice, plus rapide
If F.FilterMode Then F.ShowAllData 'si la feuille est filtrée
derlig = F.Range("S" & F.Rows.Count).End(xlUp).Row
dates = F.Range("S14:T" & derlig) 'matrice, plus rapide, au moins 2 éléments
ReDim resu(1 To UBound(dates), 1 To ncol)
'---liste des  en-têtes de colonnes---
For j = 1 To ncol
    d(dest(j).Value) = j 'mémorise le numéro de colonne
    resu(1, j) = dest(j)
Next j
'---liste des dates---
For i = 2 To UBound(dates)
    dd(dates(i, 1)) = i 'mémorise le numéro de ligne
Next i
'---tableau des résultats---
For i = 2 To UBound(tablo)
    col = d(tablo(i, 9))
    lig = dd(tablo(i, 2))
    If col > 0 And lig > 0 And IsNumeric(tablo(i, 1)) Then If CDbl(tablo(i, 1)) > resu(lig, col) Then resu(lig, col) = CDbl(tablo(i, 1))
Next i
'---restitution---
With dest.Resize(UBound(resu))
    .Value = resu
    .Replace "", 0
End With
End Sub
Mais ça manque quand même de cohérence (il peut y avoir des erreurs en colonne S).

A+
Merci pour cette proposition Job75
Cela fonctionne dans le fichier test mais comme pour la proposition de mapomme, ça ne fonctionne pas quand j'inclue le code dans mon fichier de travail. Je n'ai pas d'erreur mais les valeurs affichées dans le tableau sont toutes à 0.
Est ce que le fait qu'il y ait d'autres données présentes dans mon fichiers de travail dans les colonnes adjacentes aux colonnes que j'ai affichées dans le fichier test peut avoir une influence sur ce résultat ?
Ci-dessous une capture de ma feuille Calculs dans mon fichier de travail où l'on retrouve les colonnes que j'ai mise dans le fichier test. Je n'avais pas tout inclus, pour ne pas risquer de "polluer".

1641818529088.png
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Re,

J'ai oublié de préciser que la structure "dictionary" est définie dans une bibliothèque Windows qui s'appelle "Microsoft Scripting Runtime".

Dans VBA, il faut donc faire un lien avec cette bibliothèque. Une fois la liaison réalisée, l'avantage est que cette liaison persiste quand vous distribuez le fichier. Donc mon fichier intégrait cette liaison et vous n'avez pas eu à la faire. Mais dans votre propre fichier, cette liaison n'avait pas été faite, il faut donc la faire (une fois suffit).

Le fichier bibliothèque est un fichier xxx.DLL propre à Windows. Ce qui explique que les possesseurs de PC Apple ne puissent pas y avoir accès. Quand vous faites le lien, vous voyez dans la boite de dialogue le nom du fichier xxx.dll.

Pour faire référence à la bibliothèque, aller dans l'environnement VBA et suivez la démo jointe à ce message. N'oubliez pas ensuite de sauvegarder le fichier (pour garder la liaison).

nota: un peu flashy les couleurs de votre VBE 🤪
 

Pièces jointes

  • Accès à Dictionary.gif
    Accès à Dictionary.gif
    683.6 KB · Affichages: 31
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
Re,

Il existe une autre méthode que de faire référence à la bibliothèque. C'est la méthode qu'utilise @job75 (perso, j'emploie les deux au gré de mes envies :p)

Cette méthode consiste à déclarer le dictionary D comme une variable objet puis dans le code, avant d'utiliser D, d'effectuer le lien au moyen de l'instruction createobject().

L'avantage de cette méthode (appelée late binding) est:
  • elle libère l'utilisateur de se préoccuper de réaliser le lien à la main.
Les avantages de la première méthode (appelée early binding) sont de deux ordres:
  • quand on écrit le code, VBE propose les choix des propriétés et méthodes de l'objet D
  • d'aucuns disent qu'elle serait un epsilon plus rapide

Le fichier joint permet de voir comment fonctionnent les deux méthodes et les temps d'exécution (ne pas oublier de faire le lien pour tester la méthode "early binding".

On voit que les différences d'exécution sont minimes. Franchement, à l'échelle humaine, ce ne sont pas quelques dixièmes de seconde qui vont nous perturber.
 

Pièces jointes

  • Test dictionary.xlsm
    21.1 KB · Affichages: 4
Dernière édition:

safranien

XLDnaute Occasionnel
Merci pour cette proposition Job75
Cela fonctionne dans le fichier test mais comme pour la proposition de mapomme, ça ne fonctionne pas quand j'inclue le code dans mon fichier de travail. Je n'ai pas d'erreur mais les valeurs affichées dans le tableau sont toutes à 0.
Est ce que le fait qu'il y ait d'autres données présentes dans mon fichiers de travail dans les colonnes adjacentes aux colonnes que j'ai affichées dans le fichier test peut avoir une influence sur ce résultat ?
Ci-dessous une capture de ma feuille Calculs dans mon fichier de travail où l'on retrouve les colonnes que j'ai mise dans le fichier test. Je n'avais pas tout inclus, pour ne pas risquer de "polluer".

Regarde la pièce jointe 1127109
En complément, dans la capture en PJ, en rouge les données que je dois effacer pour que votre code fonctionne. Je n'ai pas trouver comment le modifier pour qu'il fonctionne sans avoir besoin de supprimer ces données, en sachant qu'il m'est impossible de les supprimer pour le bon fonctionnement du fichier.
En encadré violet, le noms des en-têtes de colonnes que je n'avais pas modifié. Une fois fait, et une fois les données dans l'encadré rouge supprimées, le code fonctionne.

1641826436931.png
 

job75

XLDnaute Barbatruc
Merci pour cette proposition Job75
Cela fonctionne dans le fichier test mais comme pour la proposition de mapomme, ça ne fonctionne pas quand j'inclue le code dans mon fichier de travail. Je n'ai pas d'erreur mais les valeurs affichées dans le tableau sont toutes à 0.
Il est facile de voir pourquoi : les textes en L14 M14 N14 O14 P14 ne sont pas corrects !

Ils doivent correspondre à ceux que l'on trouve en colonne J.
 

safranien

XLDnaute Occasionnel
Re,

J'ai oublié de préciser que la structure "dictionary" est définie dans une bibliothèque Windows qui s'appelle "Microsoft Scripting Runtime".

Dans VBA, il faut donc faire un lien avec cette bibliothèque. Une fois la liaison réalisée, l'avantage est que cette liaison persiste quand vous distribuez le fichier. Donc mon fichier intégrait cette liaison et vous n'avez pas eu à la faire. Mais dans votre propre fichier, cette liaison n'avait pas été faite, il faut donc la faire (une fois suffit).

Le fichier bibliothèque est un fichier xxx.DLL propre à Windows. Ce qui explique que les possesseurs de PC Apple ne puissent pas y avoir accès. Quand vous faites le lien, vous voyez dans la boite de dialogue le nom du fichier xxx.dll.

Pour faire référence à la bibliothèque, aller dans l'environnement VBA et suivez la démo jointe à ce message. N'oubliez pas ensuite de sauvegarder le fichier (pour garder la liaison).

nota: un peu flashy les couleurs de votre VBE 🤪

merci mapomme. Impressionnant ! J'ai vraiment beaucoup à apprendre c'est certain.
J'ai activé le Dictionary et n'ai plus l'erreur mentionnée précédemment mais une nouvelle est apparue (dans mon fichier de travail).
J'ai tenté de modifier le code pour faire la recopie à un autre endroit de la feuille (en colonnes CA,CB et CC plutôt qu'à l'emplacement de mon tableau dans lequel sont restitués les résultats). Peut être serait-il préférable de faire la recopie, le filtre etc dans une nouvelle feuille vierge ?

Nota : oui j'avoueque ça flashe un peu mais au final je trouve plus reposant le fond noir que blanc :)

1641827830454.png


1641827921593.png
 

safranien

XLDnaute Occasionnel
Il est facile de voir pourquoi : les textes en L14 M14 N14 O14 P14 ne sont pas corrects !

Ils doivent correspondre à ceux que l'on trouve en colonne J.

Effectivement, j'ai vu après coup que les noms des en-têtes devaient être les mêmes que dans le fichier exemple, nos réponses se sont croisées. Par contre, je suis quand même obligé de supprimer les données citées précédemment pour que le code fonctionne.
 
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
Re,

Vous n'utilisez pas le dernier code du fichier du message #31 ?
Votre code en cause ne lui ressemble guère...
C'est celui de la version sans dictionary qui n'a pas été adaptée.

Le message en question se produit quand vous modifiez une plage avec des formules matricielles et que la plage modifiée n'est pas exactement la plage d'étendue des formules matricielles initiales.
 

safranien

XLDnaute Occasionnel
Re,

Vous n'utilisez pas le dernier code du fichier du message #31 ?
Votre code en cause ne lui ressemble guère...
C'est celui de la version sans dictionary qui n'a pas été adaptée.

Le message en question se produit quand vous modifiez une plage avec des formules matricielles et que la plage modifiée n'est pas exactement la plage d'étendue des formules matricielles initiales.
oh mince j'ai du me mélanger les pinceaux. Merci. Je teste et reviens vers vous.
 

safranien

XLDnaute Occasionnel
Bonjour à tous

navré pour mon retour tardif.

@mapomme : après plusieurs essais, votre solution semble fonctionner et apporter les résultats attendus.
Merci merci beaucoup.

@job75 : votre solution semble également fonctionner mise à part que je suis obligé de ne pas avoir de données dans des colonnes/cellules adjacentes comme expliqué dans le post #37. Pensez-vous qu'il soit possible de ne plus avoir cette contrainte ?
 

job75

XLDnaute Barbatruc
Bonsoir safranien,
@job75 : votre solution semble également fonctionner mise à part que je suis obligé de ne pas avoir de données dans des colonnes/cellules adjacentes comme expliqué dans le post #37. Pensez-vous qu'il soit possible de ne plus avoir cette contrainte ?
Dans la macro de mon post #32 remplacez :
VB:
tablo = F.[B14].CurrentRegion.Resize(, 9) 'matrice, plus rapide
If F.FilterMode Then F.ShowAllData 'si la feuille est filtrée
par :
VB:
If F.FilterMode Then F.ShowAllData 'si la feuille est filtrée
tablo = F.Range("B14", F.Range("J" & F.Rows.Count).End(xlUp)) 'matrice, plus rapide
A+
 

safranien

XLDnaute Occasionnel
Bonjour job75

merci beaucoup pour votre retour. La modif fonctionne dans le fichier d'essai mais pas dans mon fichier de travail, tout reste à 0.
Il doit y avoir qqch qui ne plaît pas. Je vais essayer de trouver ce qui peut provoquer cela.

Encore merci à vous et mapomme pour votre aide précieuse.

Bonne fin de journée
 

Statistiques des forums

Discussions
314 628
Messages
2 111 337
Membres
111 105
dernier inscrit
Joffrette