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!
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas