Formules Min-Moyenne-Max en VBA

Bonjour le forum et bon dimanche,

Pour le besoin d'alléger mon fichier, j'ai commencé a mettre un substitut de formules Excel en VBA, j'ai déjà gagné quelques Ko et je dois continuer sur une feuille qui ralentit sensiblement l'exécution de macro car elle semble trop sollicité.

J'ai un tableau structuré ( TabDonnees) avec des prix de produits par mois de janvier a décembre (10 Colonnes)

je cherche a mettre les Formules MIN, MOYENNE, MAX, sous forme de valeurs et non incrémenter la formule dans les cellules. Grace a mon bouton de commande (CommandButton1) de l'UserFome1. le code se trouverait dans un module. je dois me servir du tableau structuré pour écrire les codes pour ne pas avoir de lignes vides dans le tableau Excel.

Avant de poster cette demande , j'ai passé quelques heures a faire et défaire et encore faire faire et défaire, essayé l'enregistreur de macro, je n'y parvient pas! l'écriture du code avec le tableau structuré me pose des soucis.

Merci beaucoup a tout ceux qui pourront me donner un petit coups de pouce.

J'ai laissé les formules Excel sur les 1er lignes (colonne N, O, P) du tableau pour référence a ma demande

MIN dans la colonne N ("TabDonnees[Meilleur Prix]")

MOYENNE dans la colonne O ("TabDonnees[Moyenne]")

MAX dans la colonne P ("TabDonnees[Prix le plus haut]")

je vous souhaites un bon dimanche et merci comme toujours pour votre précieuse aide.

Bonjour,

Merci pour ta réponse, je cherche vraiment la solution en code VBA, je dois avouer que je ne connais absolument rien a Power Query, (je devrais certainement m'y pencher bientôt)

J'ai peur d'incrémenter quelque chose dans le fichier sans savoir comment ca fonctionne.

Merci quand même

Re-,

Et aussi, je dois passer par mon bouton de commande pour déclencher le code qui mettra a jour toutes les cellules de la colonne N,O,P du tableau structuré.

merci encore et bon dimanche également

bonjour, 3 propositions, de plus en plus en mémoire ... (mais en temps d'éxécution, nulle différence)

Sub Teste1()
     Dim aOut, c, t, i, k
     t = Timer
     Set c = Sheets("feuil1").ListObjects(1).DataBodyRange     'vos données
     ReDim aOut(1 To c.Rows.Count, 1 To 3)     'dimensioner matrice pour les résultats
     k = c.Columns.Count - 3     'nombre de colonnes avec des données

     For i = 1 To c.Rows.Count     'boucle les lignes
          aOut(i, 1) = WorksheetFunction.Min(c(i, 1).Resize(, k))     'meilleur prix
          aOut(i, 2) = WorksheetFunction.Average(c(i, 1).Resize(, k))     'moyenne
          aOut(i, 3) = WorksheetFunction.Max(c(i, 1).Resize(, k))     'max prix
     Next
     c.Cells(1, k + 1).Resize(UBound(aOut), UBound(aOut, 2)).Value = aOut     'coller les résultat
     MsgBox Format(Timer - t, "0.00\s")
End Sub

Sub Teste2()
     Dim aOut, c, t, i, k, aa
     t = Timer
     Set c = Sheets("feuil1").ListObjects(1).DataBodyRange     'vos données
     ReDim aOut(1 To c.Rows.Count, 1 To 3)     'dimensioner matrice pour les résultats
     k = c.Columns.Count - 3     'nombre de colonnes avec des données

     For i = 1 To c.Rows.Count
          aa = c.Cells(i, 1).Resize(, k).Value
          aOut(i, 1) = WorksheetFunction.Min(aa)     'meilleur prix
          aOut(i, 2) = WorksheetFunction.Average(aa)     'moyenne
          aOut(i, 3) = WorksheetFunction.Max(aa)     'max prix
     Next

     c.Cells(1, k + 1).Resize(UBound(aOut), UBound(aOut, 2)).Value = aOut     'coller les résultat
     MsgBox Format(Timer - t, "0.00\s")
End Sub

Sub Teste3()
     Dim aOut, c, t, i, k, aA, j, aB
     t = Timer
     Set c = Sheets("feuil1").ListObjects(1).DataBodyRange     'vos données
     ReDim aOut(1 To c.Rows.Count, 1 To 3)     'dimensioner matrice pour les résultats
     k = c.Columns.Count - 3     'nombre de colonnes avec des données
     aB = c.Value
     ReDim aA(1 To k)
     For i = 1 To c.Rows.Count
          For j = 1 To k: aA(j) = aB(i, j): Next
          aOut(i, 1) = WorksheetFunction.Min(aA)     'meilleur prix
          aOut(i, 2) = WorksheetFunction.Average(aA)     'moyenne
          aOut(i, 3) = WorksheetFunction.Max(aA)     'max prix
     Next

     c.Cells(1, k + 1).Resize(UBound(aOut), UBound(aOut, 2)).Value = aOut     'coller les résultat
     MsgBox Format(Timer - t, "0.00\s")
End Sub

Bonsoir Bart,

merci infiniment pour ce code, j'ai chois le Teste1 et avec le fichier que j'ai mis comme exemple c'est vraiment ce que je cherche, je joue avec depuis quelques minutes maintenant et tout fonctionne vraiment bien a quelques détails que je voudrais vous faire part si vous êtes d'accord.

- quand il n'y a pas de montant ou un si il y a un caractère du style #REF entre le mois de janvier et décembre ca bogue

le plus important (j'aurais du le mentionner, on est jamais assez trop précis) c'est que j'ai 20 autres colonnes a gauche du mois de janvier donc quand j'ai essayé de transposer votre code dans mon fichier, ca ne fonctionne pas. je pense que le code prend toutes les données a partir de la 1er colonne.

J'ai bien essayé de changer (mes données) dans la 1er ligne du code mais sans succès

pouvez vous m'aider a configurer votre code, je ne le comprend pas entièrement.

merci énormément

Finalement a force de jouer dedans , vois ce que j'ai trouvé et qui a l'air de fonctionner. ce n'est peut-être pas la bonne façon d'écrire mais mes faibles connaissances ne me permettent pas de m'y prendre autrement.

Sub Teste1()

Dim aOut, t, i, k

t = Timer

Dim c As Range

With Sheets("Feuil1")

Set c = .Range(.Cells(4, 21), .Cells(.UsedRange.Rows.Count, .Cells(4, Columns.Count).End(xlToLeft).Column))

ReDim aOut(1 To c.Rows.Count, 1 To 3) 'dimensioner matrice pour les résultats

k = c.Columns.Count - 3 'nombre de colonnes avec des données

For i = 1 To c.Rows.Count 'boucle les lignes

aOut(i, 1) = WorksheetFunction.Min(c(i, 1).Resize(, k)) 'meilleur prix

aOut(i, 2) = WorksheetFunction.Average(c(i, 1).Resize(, k)) 'moyenne

aOut(i, 3) = WorksheetFunction.Max(c(i, 1).Resize(, k)) 'max prix

Next

c.Cells(1, k + 1).Resize(UBound(aOut), UBound(aOut, 2)).Value = aOut 'coller les résultat

MsgBox Format(Timer - t, "0.00\s")

End With

End Sub

Par contre si possible de me dire quand une ligne est vide de janvier a décembre ou encore il y a une #REF de pouvoir malgré tout continuer le code sans qu'il se bloque.

- il y a aussi le code pour la moyenne qui se bloque quand je n'ai qu'eu seul prix entre janvier et décembre.

merci infiniment pour votre aide, et de vous êtes pencher sur mon petit soucis

Re-,

cousin,

C'est bien correct, je comprends que certaines choses te dérange mais je fais avec les moyens du bord et surtout tu ne sais pas ou je suis rendu avec mon fichier.

je fais avec le temps que j'ai et crois moi je n'en ai pas beaucoup a consacrer . Pour la moquerie, j'en ai pas besoin non plus !

sur ce bonne soirée

Pour ceux que ca pourrait intéressé, le code ne bloque plus avec l'insertion ses deux ligne de plus.

bonne fin de dimanche et merci beaucoup pour ton aide Bard

Sub PrixMinMoyenneMax()

Dim aOut, t, i, k

t = Timer

Dim c As Range

With Sheets("Base_Données")

Set c = .Range(.Cells(4, 21), .Cells(.UsedRange.Rows.Count, .Cells(4, Columns.Count).End(xlToLeft).Column))

ReDim aOut(1 To c.Rows.Count, 1 To 3) 'dimensioner matrice pour les résultats

k = c.Columns.Count - 3 'nombre de colonnes avec des données

On Error Resume Next

For i = 1 To c.Rows.Count 'boucle les lignes

aOut(i, 1) = WorksheetFunction.Min(c(i, 1).Resize(, k)) 'meilleur prix

aOut(i, 2) = WorksheetFunction.Average(c(i, 1).Resize(, k)) 'moyenne

aOut(i, 3) = WorksheetFunction.Max(c(i, 1).Resize(, k)) 'max prix

Next

c.Cells(1, k + 1).Resize(UBound(aOut), UBound(aOut, 2)).Value = aOut 'coller les résultat

MsgBox Format(Timer - t, "0.00\s")

On Error GoTo 0

End With

End Sub

re,

worksheetfunction.aggregate --> https://learn.microsoft.com/fr-fr/office/vba/api/excel.worksheetfunction.aggregate

Sub Teste1()
     Dim aOut, c, t, i, k, x
     t = Timer
     Set c = Range("TabDonnees[[Prix_Jan]:[Prix Dec]]")     'les données (=prix) de ces mois sans l'entête
     ReDim aOut(1 To c.Rows.Count, 1 To 4)    'dimensioner matrice pour les résultats
     k = c.Columns.Count     'nombre de colonnes de cette plage

     For i = 1 To c.Rows.Count    'boucle les lignes
          Set c1 = c(i, 1).Resize(, k)     'une ligne de cette plage (Jan->Dec)
          If WorksheetFunction.Count(c1) > 0 Then     'min 1 cellule avec données "numériques"
     'explication aggregate : https://learn.microsoft.com/fr-fr/office/vba/api/excel.worksheetfunction.aggregate
               aOut(i, 1) = WorksheetFunction.Aggregate(5, 6, c1)     'meilleur prix (sans erreurs)
               aOut(i, 2) = WorksheetFunction.Aggregate(1, 6, c1)    'moyenne (sans erreurs)
               aOut(i, 3) = WorksheetFunction.Aggregate(4, 6, c1)       'max prix (sans erreurs)
               aOut(i, 4) = WorksheetFunction.Aggregate(2, 6, c1)      'nombre de données numeriques
          End If
     Next

     Range("TabDonnees[Meilleur]").Resize(UBound(aOut), UBound(aOut, 2)).Value = aOut    'coller le résultat à partir de la colonne "Meilleur"

     MsgBox Format(Timer - t, "0.00\s")
End Sub

Un très grand Merci . En plus bien expliqué, ca fonctionne super bien. Je vais m'amuser un peu avec ce nouveau code.

en vous souhaitant une belle soirée