XL 2016 Compteur avec conditions

[robertduval]

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

 

[fanch55]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
    If Not Intersect(Target, Columns("K")) Is Nothing Then
        For Each Cell In Target.Cells
            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
        Next
    End If
End Sub

 

[robertduval]

Salut fanch55, soan

Fanch55 j'ai testé ton nouveau programme toujours pareil j'ai juste une dizaine de lignes écrites dans la mise a jour, réparties sur environ 45 lignes et ça me met toujours un temps fou et si j'ai le malheur de toucher la souris me fait planter Excel, je crois qu'il me calcule la colonne K entière même si elle n'a que 10 lignes écrites, je pense que tu es pas loin merci encore pour vos retours

 

[soan]

Bonjour Robert, fanch,

en retour, le fichier de ton post #10.

pour les 3 colonnes G, K et L, y'a aucune donnée ! y'a que les en-têtes de colonnes ! ne t'inquiètes pas, c'est normal ! (c'est car j'ai supprimé les formules) ; fais Ctrl e ➯ travail effectué ! (vérifie les résultats)
​

---

code VBA de Module1

Option Explicit

Sub Essai()
  Dim nlm&, n&: nlm = Rows.Count
  n = Cells(nlm, 1).End(3).Row: If n = 1 Then Exit Sub
  Dim Tbl, ft$, t%, k As Byte, i&: Application.ScreenUpdating = 0
  n = n - 1: [G2].Resize(n) = Empty: [K2].Resize(n, 2) = Empty
  n = Cells(nlm, 9).End(3).Row: If n = 1 Then Exit Sub
  n = n - 1: Tbl = [G2].Resize(n, 6)
  For i = 1 To n
    ft = Tbl(i, 3)
    If ft <> "" Then
      k = -(ft = "0 - 0")
      Tbl(i, 5) = Chr$(79 - k): Tbl(i, 6) = k
      If k = 0 Then t = 0 Else t = t + 1
      Tbl(i, 1) = t
    End If
  Next i
  [G2].Resize(n) = Application.Index(Tbl, Evaluate("Row(" & "1:" & n & ")"), 1)
  [K2].Resize(n, 2) = Application.Index(Tbl, Evaluate("Row(" & "1:" & n & ")"), _
    [Column(E:F)])
End Sub

si besoin, tu peux demander une adaptation.
à te lire pour avoir ton avis.

soan

 

[robertduval]

Salut Fanch55, soan

Soan déjà merci pour ce roman.....je sais pas a quoi tu tournes mais je pense que c'est déjà très puissant ne change rien

Je n'ai rien contre le Vba, c'est plus difficile a comprendre c'est tout, mais si c'est bien expliqué c'est un régal, en plus c'est indispensable dans excel, je vous remercie encore de prendre du temps pour moi, bon soan tu vas être encore déçu désolé mais je n'arrive pas a faire ce que je souhaite avec ton fichier, celui de fanch55 fonctionne nickel sauf qu'il me fait planter excel car il calcule trop, je vais donc vous embêter encore une fois tous les 2 et après je pense que je changerais d'approche je vous met en pj le fichier

Merci encore

 

[fanch55]

Oki, c'est une colonne entière que tu copies, soient un peu plus d'1 million de lignes ....
On va limiter le nombre de vérifs non indispensables :

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 "N": Cell.Offset(0, -5) = Cell.Offset(0, -5) + 1
                    Case "O": Cell.Offset(0, -5) = 0
                    Case Else:   ' Rien
                End Select
                Application.EnableEvents = True
            Next
        End If
    End If
End Sub

 

[robertduval]

Ouiiiiiiii Merci fanch55 tt fonctionne merci encore a vous 2