XL 2016 Compteur avec conditions

robertduval

XLDnaute Junior
Bonjour je souhaiterais une colonne compteur qui suivant la valeur additionne ou remet a zero Merci
 

Pièces jointes

  • Test.xlsx
    10.2 KB · Affichages: 23
Solution
Oki, c'est une colonne entière que tu copies, soient un peu plus d'1 million de lignes ....o_O
On va limiter le nombre de vérifs non indispensables :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
    If Not Intersect(Target, Columns("L")) Is Nothing Then
        Set P = Target.Find("*", Target.Cells(Target.Count), , , xlByColumns, xlNext) 'Première cellule non vide
        Set L = Target.Find("*", Target.Cells(1), , , xlByColumns, xlPrevious) 'Dernière cellule non vide
        If Not L Is Nothing And Not P Is Nothing Then
            For Each Cell In Range(P, L).Cells
                Application.EnableEvents = False
                Cell = UCase(Cell)
                Select Case Cell
                    Case...

fanch55

XLDnaute Barbatruc
Avec ce code à mettre dans celui de la feuille concernée et si le critère est la colonne A :
Nota: la colonne "B" ne sert à rien
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
    For Each Cell In Target.Cells
        If Not Intersect(Cell, Columns("A")) Is Nothing Then
            Application.EnableEvents = False
            Cell = UCase(Cell)
            Select Case Cell
                Case "N": Cell.Offset(0, 2) = Cell.Offset(0, 2) + 1
                Case "O": Cell.Offset(0, 2) = 0
                Case Else:   ' Rien
            End Select
            Application.EnableEvents = True
        End If
    Next
End Sub
 

soan

XLDnaute Barbatruc
Inactif
Bonjour Robert, fanch,

ton fichier en retour. :)

* ta formule en B2 pouvait être simplifiée en : =--(A2="N")

* j'ai préféré supprimer toutes tes formules de la colonne B. 😁

* y'a maint'nant 3 feuilles, car j'ai préféré séparer tes 3 exemples. 😁

* sur chaque feuille, fais Ctrl e, et vérifie les résultats. 😉



code VBA de Module1 :

VB:
Option Explicit

Sub Essai()
  Dim n&: n = Cells(Rows.Count, 1).End(3).Row: If n = 1 Then Exit Sub
  Dim t%, k As Byte, i&: Application.ScreenUpdating = 0
  For i = 2 To n
    With Cells(i, 1)
      k = -(.Value = "N"): .Offset(, 1) = k
      If k = 0 Then t = 0 Else t = t + 1
      .Offset(, 2) = t
    End With
  Next i
End Sub

soan
 

Pièces jointes

  • Test.xlsm
    16.4 KB · Affichages: 7

fanch55

XLDnaute Barbatruc
Bonjour Robert, Salut Soan,

Le code s'activera automatiquement à chaque modification de cellule .

Ce qu'il fait :
Pour toutes les cellules modifiées :
Si elles sont dans la colonne "A":
Si la cellule est égale à "N", la cellule à 2 colonnes à sa droite sera incrémentée de 1
Si la cellule est égale à "O", la cellule à 2 colonnes à sa droite sera égale à 0
 

robertduval

XLDnaute Junior
Bonjour je n'ai pas réussi a intégré vos formules dans mon fichier réel ça fonctionne parfaitement sur ce que vous m'avez renvoyé mais des que je bascule sur le mien, je n'y arrive pas si vous pouviez me le regarder en pj je vous envoie le réel Merci
 

Pièces jointes

  • Test.xlsx
    22.5 KB · Affichages: 6

fanch55

XLDnaute Barbatruc
Code pour Feuil2 :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
    For Each Cell In Target.Cells
        If Not Intersect(Cell, Columns("K")) Is Nothing Then
            Application.EnableEvents = False
            Cell = UCase(Cell)
            Select Case Cell
                Case "N": Cell.Offset(0, -4) = Cell.Offset(0, -4) + 1
                Case "O": Cell.Offset(0, -4) = 0
                Case Else:   ' Rien
            End Select
            Application.EnableEvents = True
        End If
    Next
End Sub
 

robertduval

XLDnaute Junior
Salut fanch55,

J'ai bien regardé tout fonctionne nickel, j'ai juste un petit rajout dans ton programme stp, peut tu me rajouter une ligne ou 2 qui dit que si dans la colonne K la cellule est vide qu'il ne fasse pas de calcul (mais surtout qu'il me garde en mémoire ce qu'il y a déjà dans la cellule) car ma colonne K fais 500 lignes avec juste quelques lignes aléatoires et quand je met en route il me calcule les 500 lignes ça me met un temps fou Merci ;)

Si tu veut un fichier exemple dis moi Merci👍