Excel-VBA compter le nombre de fois que des cellules prennent la valeur maximale

excelfresh

XLDnaute Nouveau
Bonjour le forum!

J’ai des valeurs aléatoire dans la plage [B6:E6].

J’aimerais compter à l’aide d’une macro combien de fois les cellules B6, C6, D6 ; E6 prennent chacune la valeur maximale après 10 calculs consécutifs (Appuyer F9 dix fois).

J’ai écrit un code et il n’a pas l’air de fonctionner.

Pouvez-vous, s’il vous plait m’aider à atteindre mon but ?

Merci.
 

Fichiers joints

vgendron

XLDnaute Barbatruc
Bonjour
un essai avec ce code
VB:
Sub compter()
Range("B4:E5").Select
Selection.ClearContents

Application.Calculation = xlCalculationManual 'désactive le calcul automatique

With Sheets("Tabelle1") 'dasn la feuille tabelle1
    For i = 1 To 10 'faire 10 fois
        Calculate
        If .[b6] = Application.WorksheetFunction.Max(.[b6:e6]) Then
            .[b5] = .[b5] + 1 'si B6 est le maximum ==> on incrémente de 1
            .[b4] = .[b4] + .[b5] 'à quoi sert cette ligne??
'        Else
'            .[b5].Value = 0
        End If
      

        If .[c6] = Application.WorksheetFunction.Max(.[b6:e6]) Then
            .[C5] = .[C5] + 1
            .[c4] = .[c4] + .[C5]
'        Else
'            .[C5].Value = 0
        End If
      

        If .[d6] = Application.WorksheetFunction.Max(.[b6:e6]) Then
            .[D5] = .[D5] + 1
            .[d4] = .[d4] + .[D5]
'        Else
'            .[D5].Value = 0
        End If
      
  
        If .[e6] = Application.WorksheetFunction.Max(.[b6:e6]) Then
            .[E5] = .[E5] + 1
            .[e4] = .[e4] + .[E5]
'        Else
'            .[E5].Value = 0
        End If
      
    Next i
End With

Application.Calculation = xlCalculationAutomatic

End Sub
 

excelfresh

XLDnaute Nouveau
Bonjour
un essai avec ce code
VB:
Sub compter()
Range("B4:E5").Select
Selection.ClearContents

Application.Calculation = xlCalculationManual 'désactive le calcul automatique

With Sheets("Tabelle1") 'dasn la feuille tabelle1
    For i = 1 To 10 'faire 10 fois
        Calculate
        If .[b6] = Application.WorksheetFunction.Max(.[b6:e6]) Then
            .[b5] = .[b5] + 1 'si B6 est le maximum ==> on incrémente de 1
            .[b4] = .[b4] + .[b5] 'à quoi sert cette ligne??
'        Else
'            .[b5].Value = 0
        End If
     

        If .[c6] = Application.WorksheetFunction.Max(.[b6:e6]) Then
            .[C5] = .[C5] + 1
            .[c4] = .[c4] + .[C5]
'        Else
'            .[C5].Value = 0
        End If
     

        If .[d6] = Application.WorksheetFunction.Max(.[b6:e6]) Then
            .[D5] = .[D5] + 1
            .[d4] = .[d4] + .[D5]
'        Else
'            .[D5].Value = 0
        End If
     
 
        If .[e6] = Application.WorksheetFunction.Max(.[b6:e6]) Then
            .[E5] = .[E5] + 1
            .[e4] = .[e4] + .[E5]
'        Else
'            .[E5].Value = 0
        End If
     
    Next i
End With

Application.Calculation = xlCalculationAutomatic

End Sub
Enorme MERCI!
 

Discussions similaires


Haut Bas