Création d'un compteur

Bonjour,

J'aimerais de l'aide afin de d'insérer un compteur dans un document. Je vais essayer d'être le plus clair possible.

Il me faudrait donc un compteur dans la cellule A6 qui cumule toutes les entrées de la cellule A5 (ex : si j'entre 100 en A5, j'aurai 100 en A6 ; si ensuite j'entre 50 en A5, j'aurai 150 en A6 ; et ainsi de suite)

Je voudrais également pouvoir mettre à zéro le compteur une fois à l'année

Merci pour votre aide

Cordialement

bonjour

tu peux essayer cela

1) outils >optons>calcul tu cohes itetration ; a nombre tu mets 1

ton calcul a5+a6 sera un cumul de a5 et a6

cordialement

Bonjour à tous,

Pour le compteur, dans le VBE de la feuille

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Application.Intersect(Target, Range("a5")) Is Nothing Then
        Range("a6") = Range("a6") + Target
    End If
End Sub

Pour remise à zéro du compteur, dans un module

Sub CompteurAzéro()
    Range("a6").ClearContents
End Sub

Amicalement

Claude

Super génial, merci, ça fonctionne

Je cherchais quelque chose de beaucoup plus compliqué, comme quoi...

re,

J'ai crié victoire trop vite, car en fait je voudrais des compteurs sur plusieurs colonnes.

Je ne peux pas utiliser la méthode de Tulipe car tous les compteurs cumulent chaque entrée.

Pour la méthode de Dubois, comment faut-il faire pour étendre la formule à plusieurs colonnes ?

Merci pour vos réponses

re,

Faut voir la structure du fichier réel

sinon, c'est de l'aveuglette !

Claude

Voici mon document

re,

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cL%
If Flag = True Then Exit Sub
    If Not Application.Intersect(Target, Range("a5:e5")) Is Nothing Then
    If Target.Count > 1 Then Exit Sub

    cL = Target.Column
    Cells(6, cL) = Cells(6, cL) + Target
        Flag = True
    Cells(5, cL).ClearContents
        Flag = False
    End If
End Sub

Claude

merci beaucoup, la formule est presque impeccable mais j'aimerais que le chiffre entré reste visible car c'est un tableau hebdomadaire avec le cumul annuel. Donc il est important de voir les chiffres de la semaine

remplace le code par celui-ci

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cL%
    If Not Application.Intersect(Target, Range("a5:e5")) Is Nothing Then
        If Target.Count > 1 Then Exit Sub
        cL = Target.Column
        Cells(6, cL) = Cells(6, cL) + Target
    End If
End Sub

Bonjour,

La formule est impeccable mais je la voudrais également pour les lignes 9 et 10

Je sais, je suis embetante........

Bonjour,

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cL%
    If Not Application.Intersect(Target, Range("a5:e5")) Is Nothing Then
        If Target.Count > 1 Then Exit Sub
        cL = Target.Column
        Cells(6, cL) = Cells(6, cL) + Target
    End If

    If Not Application.Intersect(Target, Range("a9:e9")) Is Nothing Then
        If Target.Count > 1 Then Exit Sub
        cL = Target.Column
        Cells(10, cL) = Cells(10, cL) + Target
    End If
End Sub

    Sub CompteurAzéro()
        Range("a5:e6").ClearContents
        Range("a9:e10").ClearContents
    End Sub

Claude

Un hyper grand merci, ça fonctionne à merveille, je n'aurais pas su y arriver toute seule

re,

essaye d'analyser ces quelques lignes de code,

il n'y a rien de sorcier et tu aurais pu modifier toi-même

Amicalement

Claude