VBA EXCEL - Max liste

Question

Bonjour,

j'ai besoin de faire des calculs sur un tableau, colonne par colonne.
Pour cela, j'ai crée une boucle for qui parcourt toutes les lignes du tableau.
Pour le calcul, il existe une fonction qui renvoie une valeur qui dépend de l'intitulé de la ligne et de la cellule dans laquelle on se place.
Mais il y a une petite complication!

si j'obtiens jusqu'à deux fois le mot SALADE dans la colonne, on calcule normalement
si par contre je rencontre 3 fois ou plus le mot SALADE dans la colonne, alors je dois prendre les 2 valeurs maxi que me renvoient la fonction, comment faire??

J'ai pensé différencié les cas, 
- calculer pour tous les autres mots
- garder le résultat calcul dans une liste(? comment fait-on?) lorsque le mot salade apparait
- et à la fin     si compteur (salade)<=2, alors on calcule normalement
                     si compteur(salade)>2 alors on prend les 2 max de la liste, comment faire??

Merci beaucoup de votre aide

si je n'ai pas été claire, dites le moi, je préciserai au mieux !

michel_m · Answer

Re, décidément, on se voit souvent!... je me suis basé sur "salade"; à toi de créer la variable correspondante macro à adapter

Sub trouver_max1er2()
'liste en colonne A, valeurs en colonne B
'col_A correspond à la zone en colonne A
Dim tablo()
ReDim tablo(0)
terme = "salade"
nbre = Application.CountIf(Range("col_A"), terme)
If nbre > 2 Then
'collecte les valeurs de "salade"
dep = "A65536"
For cptr = 0 To nbre - 1
    lig = Columns(1).Find(terme, Range(dep)).Row
    tablo(cptr) = Cells(lig, 2)
    ReDim Preserve tablo(cptr + 1)
    dep = Cells(lig, 1).Address
Next
'trie le tablo en décroissant
For i = 0 To nbre - 1
        j = i
        For k = j + 1 To nbre
            If tablo(k) >= tablo(j) Then j = k
        Next k
    If i <> j Then
        tmp = tablo(j)
        tablo(j) = tablo(i)
        tablo(i) = tmp
    End If
  Next i
  'renvoie les 2 valeurs les + hautes
  maxi_1 = tablo(0)
  maxi_2 = tablo(1)

End If
End Sub

Cha69 · Answer

Merci encore Michel, je suis en train de récomposer le code pr le comprendre, ms que veut dire <>? vous vous en etes servi pour trier le tableau en terme décroissant

michel_m · Answer

Pour piger, utilise les espions dans VBE
tu sélectionne une variable (tablo,i,j, k...)
 et débogage_ajouter un espion
et avance en pas à pas avec F8
le" tri à bulles " est loin d'être évident à assimiler

Cha69 · Answer

espion = add watch??
j'ai la version anglaise et je ne comprends pas tt,

j'ai encore un probleme, mon calcul ne se fait pas !! J'ai fait qq modif pour l'insérer dans la fonction,
la fonction renvoie la bonne valeur lorsque la colonne est vide!!
je déprime !

code:

Function Conso_jour(numero_colonne, numero_ligne_1ere_operation, numero_ligne_dernière_operation, NbNEP As Integer, utilite As String)

' Déclaration des variables

Dim somme As Integer
Dim a As Integer
Dim b As Integer
Dim i As Integer
Dim compteur As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim p As Integer
Dim tableau()
ReDim tableau(0)

terme = "NEP"
nb = Application.CountIf(Range("E4:E51"), terme)

somme = 0
a = 0

' Boucle de calculs

For i = numero_ligne_1ere_operation To numero_ligne_dernière_operation Step 3

If Application.CountIf(Range("ListeOp"), Cells(i, numero_colonne)) = 0 Or Application.CountIf(Range("ListeEqt"), Cells(i + 1, 1)) = 0 Then
a = 0

ElseIf Application.CountIf(Range(NEP), Cells(i, numero_colonne)) = 0 Or nb <= NbNEP Then
a = Debit_Puissance(Cells(i, numero_colonne), Cells(i + 1, 1), utilite)

Else: a = 0

End If

somme = somme + a
a = 0

Next

If nb > NbNEP Then
dep = A65536
For compteur = 0 To nb - 1
Ligne = Columns(numero_colonne).Find(terme, Range(dep)).Row
tableau(compteur) = Cells(Ligne, Debit_Puissance(Cells(Ligne, numero_colonne), Cells(Ligne + 1, numero_colonne), utilite))
ReDim Preserve tableau(compteur + 1)
dep = Cells(Ligne, numero_colonne).Address
Next

For l = 0 To nb - 1
j = l

For k = j + 1 To nb
If tableau(k) >= tableau(j) Then
j = k
End If
Next k

If l <> j Then
tmp = tableau(j)
tableau(j) = tableau(l)
tableau(l) = tmp
End If

Next l

For p = 0 To NbNEP - 1
b = b + tableau(l)
Next

End If

somme = somme + b
Conso_jour = somme

End Function

Voyez-vous l'erreur??
MERCI

Cha69 · Answer

espion = add watch??
j'ai la version anglaise et je ne comprends pas tt,

j'ai encore un probleme, mon calcul ne se fait pas !! J'ai fait qq modif pour l'insérer dans la fonction,
la fonction renvoie la bonne valeur lorsque la colonne est vide!!
je déprime !

code:

Function Conso_jour(numero_colonne, numero_ligne_1ere_operation, numero_ligne_dernière_operation, NbNEP As Integer, utilite As String)

' Déclaration des variables

Dim somme As Integer
Dim a As Integer
Dim b As Integer
Dim i As Integer
Dim compteur As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim p As Integer
Dim tableau()
ReDim tableau(0)

terme = "NEP"
nb = Application.CountIf(Range("E4:E51"), terme)

somme = 0
a = 0

' Boucle de calculs

For i = numero_ligne_1ere_operation To numero_ligne_dernière_operation Step 3

If Application.CountIf(Range("ListeOp"), Cells(i, numero_colonne)) = 0 Or Application.CountIf(Range("ListeEqt"), Cells(i + 1, 1)) = 0 Then
a = 0

ElseIf Application.CountIf(Range(NEP), Cells(i, numero_colonne)) = 0 Or nb <= NbNEP Then
a = Debit_Puissance(Cells(i, numero_colonne), Cells(i + 1, 1), utilite)

Else: a = 0

End If

somme = somme + a
a = 0

Next

If nb > NbNEP Then
dep = A65536
For compteur = 0 To nb - 1
Ligne = Columns(numero_colonne).Find(terme, Range(dep)).Row
tableau(compteur) = Cells(Ligne, Debit_Puissance(Cells(Ligne, numero_colonne), Cells(Ligne + 1, numero_colonne), utilite))
ReDim Preserve tableau(compteur + 1)
dep = Cells(Ligne, numero_colonne).Address
Next

For l = 0 To nb - 1
j = l

For k = j + 1 To nb
If tableau(k) >= tableau(j) Then
j = k
End If
Next k

If l <> j Then
tmp = tableau(j)
tableau(j) = tableau(l)
tableau(l) = tmp
End If

Next l

For p = 0 To NbNEP - 1
b = b + tableau(l)
Next

End If

somme = somme + b
Conso_jour = somme

End Function

Voyez-vous l'erreur??
MERCI

Cha69 · Answer

espion = add watch??
j'ai la version anglaise et je ne comprends pas tt,

j'ai encore un probleme, mon calcul ne se fait pas !! J'ai fait qq modif pour l'insérer dans la fonction,
la fonction renvoie la bonne valeur lorsque la colonne est vide!!
je déprime !

code:

Function Conso_jour(numero_colonne, numero_ligne_1ere_operation, numero_ligne_dernière_operation, NbNEP As Integer, utilite As String)

' Déclaration des variables

Dim somme As Integer
Dim a As Integer
Dim b As Integer
Dim i As Integer
Dim compteur As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim p As Integer
Dim tableau()
ReDim tableau(0)

terme = "NEP"
nb = Application.CountIf(Range("E4:E51"), terme)

somme = 0
a = 0

' Boucle de calculs

For i = numero_ligne_1ere_operation To numero_ligne_dernière_operation Step 3

If Application.CountIf(Range("ListeOp"), Cells(i, numero_colonne)) = 0 Or Application.CountIf(Range("ListeEqt"), Cells(i + 1, 1)) = 0 Then
a = 0

ElseIf Application.CountIf(Range(NEP), Cells(i, numero_colonne)) = 0 Or nb <= NbNEP Then
a = Debit_Puissance(Cells(i, numero_colonne), Cells(i + 1, 1), utilite)

Else: a = 0

End If

somme = somme + a
a = 0

Next

If nb > NbNEP Then
dep = A65536
For compteur = 0 To nb - 1
Ligne = Columns(numero_colonne).Find(terme, Range(dep)).Row
tableau(compteur) = Cells(Ligne, Debit_Puissance(Cells(Ligne, numero_colonne), Cells(Ligne + 1, numero_colonne), utilite))
ReDim Preserve tableau(compteur + 1)
dep = Cells(Ligne, numero_colonne).Address
Next

For l = 0 To nb - 1
j = l

For k = j + 1 To nb
If tableau(k) >= tableau(j) Then
j = k
End If
Next k

If l <> j Then
tmp = tableau(j)
tableau(j) = tableau(l)
tableau(l) = tmp
End If

Next l

For p = 0 To NbNEP - 1
b = b + tableau(l)
Next

End If

somme = somme + b
Conso_jour = somme

End Function

Voyez-vous l'erreur??
MERCI

Cha69 · Answer

espion = add watch??
j'ai la version anglaise et je ne comprends pas tt,

j'ai encore un probleme, mon calcul ne se fait pas !! J'ai fait qq modif pour l'insérer dans la fonction,
la fonction renvoie la bonne valeur lorsque la colonne est vide!!
je déprime !

code:

Function Conso_jour(numero_colonne, numero_ligne_1ere_operation, numero_ligne_dernière_operation, NbNEP As Integer, utilite As String)

' Déclaration des variables

Dim somme As Integer
Dim a As Integer
Dim b As Integer
Dim i As Integer
Dim compteur As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim p As Integer
Dim tableau()
ReDim tableau(0)

terme = "NEP"
nb = Application.CountIf(Range("E4:E51"), terme)

somme = 0
a = 0

' Boucle de calculs

For i = numero_ligne_1ere_operation To numero_ligne_dernière_operation Step 3

If Application.CountIf(Range("ListeOp"), Cells(i, numero_colonne)) = 0 Or Application.CountIf(Range("ListeEqt"), Cells(i + 1, 1)) = 0 Then
a = 0

ElseIf Application.CountIf(Range(NEP), Cells(i, numero_colonne)) = 0 Or nb <= NbNEP Then
a = Debit_Puissance(Cells(i, numero_colonne), Cells(i + 1, 1), utilite)

Else: a = 0

End If

somme = somme + a
a = 0

Next

If nb > NbNEP Then
dep = A65536
For compteur = 0 To nb - 1
Ligne = Columns(numero_colonne).Find(terme, Range(dep)).Row
tableau(compteur) = Cells(Ligne, Debit_Puissance(Cells(Ligne, numero_colonne), Cells(Ligne + 1, numero_colonne), utilite))
ReDim Preserve tableau(compteur + 1)
dep = Cells(Ligne, numero_colonne).Address
Next

For l = 0 To nb - 1
j = l

For k = j + 1 To nb
If tableau(k) >= tableau(j) Then
j = k
End If
Next k

If l <> j Then
tmp = tableau(j)
tableau(j) = tableau(l)
tableau(l) = tmp
End If

Next l

For p = 0 To NbNEP - 1
b = b + tableau(l)
Next

End If

somme = somme + b
Conso_jour = somme

End Function

Voyez-vous l'erreur??
MERCI

Cha69 · Answer

espion = add watch??
j'ai la version anglaise et je ne comprends pas tt,

j'ai encore un probleme, mon calcul ne se fait pas !! J'ai fait qq modif pour l'insérer dans la fonction,
la fonction renvoie la bonne valeur lorsque la colonne est vide!!
je déprime !

code:

Function Conso_jour(numero_colonne, numero_ligne_1ere_operation, numero_ligne_dernière_operation, NbNEP As Integer, utilite As String)

' Déclaration des variables

Dim somme As Integer
Dim a As Integer
Dim b As Integer
Dim i As Integer
Dim compteur As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim p As Integer
Dim tableau()
ReDim tableau(0)

terme = "NEP"
nb = Application.CountIf(Range("E4:E51"), terme)

somme = 0
a = 0

' Boucle de calculs

For i = numero_ligne_1ere_operation To numero_ligne_dernière_operation Step 3

If Application.CountIf(Range("ListeOp"), Cells(i, numero_colonne)) = 0 Or Application.CountIf(Range("ListeEqt"), Cells(i + 1, 1)) = 0 Then
a = 0

ElseIf Application.CountIf(Range(NEP), Cells(i, numero_colonne)) = 0 Or nb <= NbNEP Then
a = Debit_Puissance(Cells(i, numero_colonne), Cells(i + 1, 1), utilite)

Else: a = 0

End If

somme = somme + a
a = 0

Next

If nb > NbNEP Then
dep = A65536
For compteur = 0 To nb - 1
Ligne = Columns(numero_colonne).Find(terme, Range(dep)).Row
tableau(compteur) = Cells(Ligne, Debit_Puissance(Cells(Ligne, numero_colonne), Cells(Ligne + 1, numero_colonne), utilite))
ReDim Preserve tableau(compteur + 1)
dep = Cells(Ligne, numero_colonne).Address
Next

For l = 0 To nb - 1
j = l

For k = j + 1 To nb
If tableau(k) >= tableau(j) Then
j = k
End If
Next k

If l <> j Then
tmp = tableau(j)
tableau(j) = tableau(l)
tableau(l) = tmp
End If

Next l

For p = 0 To NbNEP - 1
b = b + tableau(l)
Next

End If

somme = somme + b
Conso_jour = somme

End Function

Voyez-vous l'erreur??
MERCI

Cha69 · Answer

Désolée pr les répétitions, petit pb de connexion !!

Cha69 · Answer

Pb résolu, j'ai trouvé mes erreurs, y'en avait pas mal !!
comme quoi la nuit porte conseil !

Cha69 · Answer

J'ai cru que ça marchait, mais j'ai crié victoire trop vite !!!

je ne comprends pas ce que fait le code suivant:

dep="A65536"
For cptr = 0 To nbre - 1
    lig = Columns(1).Find(terme, Range(dep)).Row
    tablo(cptr) = Cells(lig, 2)
    ReDim Preserve tablo(cptr + 1)
    dep = Cells(lig, 1).Address
Next

qu'est ce que dep?
je ne vois pas où sont stockées les valeurs du tableau?

De plus, j'ai une colonne (disons 1) ou je cherche si le mot salade est écrit mais il n'y a pas de colonne 2 où il y a les valeurs, j'utilise une fonction.

pouvez-vous me réexpliquer le stockage ds le tableau, ce n'est pas clair pour moi !

MERCI BEAUCOUP

VBA EXCEL - Max liste

11 réponses

Newsletters