Deux compteurs pour une seule cellule qui prend differentes valeurs

Re bonjour,

Je vais essayer d'être precis et simple étant donné qu'on m'a fait la remarque, je joins un fichier Exemple( fait au mieux)

deux compteurs qui s'incrémentent en fonction de la valeur d'une cellule E1 ( par rapport A1 )

Si en E1 = "Ok" le compteur "Ok" s'incremente (en E8)

si en E1 ="Stat" le compteur "Stat" s'incremente.(en F8).

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Application.Intersect(Target, Range("A1")) Is Nothing Then

If Range("E1").Value Like "Stat" Then

Application.EnableEvents = False

Cells(8, 5) = Cells(8, 5) + 1

Application.EnableEvents = True

Celui ci-est pour le compteur "Stat"

Je voudrais pouvoir cumuler dans le meme code l'incrementation des différents compteurs ( et rajouter des compteur si besoin)

Un fichier joint.

Merci de vos réponses

3compteurx2.xlsm (18.21 Ko)

Bonjour,

Le code que vous présentez s'exécute uniquement sur modification de la cellule A1, est-ce bien ce que vous souhaitez ?

Si oui, je vous propose ce code :

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Cel As Integer

If Not Application.Intersect(Target, Range("A1")) Is Nothing Then
    Select Case Range("E1").Value 
        Case "Ok" 
            Cel = 1
        Case "Stat"
            Cel = 2
        Case "Truc"
            Cel = 3
        Case Else
            Cel = 0
    End Select
    If Cel > 0 Then Cells(8, 4 + Cel) = Cells(8, 4 + Cel) + 1
End If

End Sub

C'est exactement ca Merci beaucoup

Par contre si je veux rajouter une cellule reference

Select Case Range("D1").Value ? puis-je le mettre dans ce meme code ou refaire un Workheet_change ?

cette cellule D1 incrementera d'autres compteurs sur d'autres cellules mais toujours en reference à "A1"

[Private Sub Worksheet_Change(ByVal Target As Range) Dim Cel As Integer If Not Application.Intersect(Target, Range("A1")) Is Nothing Then Select Case Range("E1").Value Case "Ok" Cel = 1 Case "Stat" Cel = 2 Case "Truc" Cel = 3 Case Else Cel = 0 End Select If Cel > 0 Then Cells(8, 4 + Cel) = Cells(8, 4 + Cel) + 1 End If If Not Application.Intersect(Target, Range("A1")) Is Nothing Then Select Case Range("D1").Value End Sub

Merci

tu ne peux avoir qu'une unique macro Worksheet_change. Tu devras donc la compléter, mais il est inutile de répéter cette instruction :

If Not Application.Intersect(Target, Range("A1")) Is Nothing Then

Il te suffit d'ajouter un autre bloc "Select Case ... End Select" à la suite du premier. Mais il devra peut-être interagir avec une autre variable que "Cel" car j'imagine qu'il a pour finalité de modifier d'autres compteurs.

En effet je vais surement devoir créer d'autres variables que cel j'ai environ 40 compteurs

Merci de tes réponses je vais tester ca.

Rechercher des sujets similaires à "deux compteurs seule qui prend differentes valeurs"