XL 2016 Compteur avec conditions

robertduval · 18 Juillet 2021

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

fanch55 · 25 Juillet 2021

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 :

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 · 18 Juillet 2021

Bonjour,
En espérant que quelqu'un vienne me contredire,
je pense que votre demande est impossible à satisfaire par formule .

robertduval · 18 Juillet 2021

Ah ok tant pis et en vba avez vous une solution Merci

fanch55 · 18 Juillet 2021

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

robertduval · 18 Juillet 2021

Merci je vais tester tout ça

robertduval · 19 Juillet 2021

Bonjour comment j'active ce programme ou comment fonctionne t'il Merci

soan · 19 Juillet 2021

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

fanch55 · 19 Juillet 2021

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 · 19 Juillet 2021

Merci a vous 2 ça fonctionne, je vais utiliser la version de je dis pas comme ça vous restez amis c'est incroyable ce site, vous êtes hyper réactif, longue vie a ce forum

robertduval · 20 Juillet 2021

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

fanch55 · 20 Juillet 2021

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

soan · 20 Juillet 2021

Bonsoir fanch55, Robert,

Robert a écrit : « je n'ai pas réussi a intégrer vos formules dans mon fichier réel »

tu aurais quand même pu préciser qu'il s'agit de code VBA, et pas de formules !

ajout : il faut un fichier .xlsm pour contenir du code VBA ; ou un ancien .xls.

soan

robertduval · 21 Juillet 2021

Merci fanch55 je vais regarder tout ça , soan j'avais mis le xlsm c'étais pas ça le problème, juste un problème d'adaptation je pense merci encore a vous 2

robertduval · 22 Juillet 2021

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

soan · 22 Juillet 2021

Bonsoir Robert, fanch,

en retour, le fichier de ton post #10.

formule en K2 : =SI(I2="";"";SI(I2="0 - 0";"N";"O"))

formule en L2 : =SI(I2="";"";--(K2="N"))

ces 2 formules sont déjà étirées jusqu'en ligne 20.

soan

XL 2016 Compteur avec conditions

robertduval

XLDnaute Junior

Pièces jointes

fanch55

fanch55

XLDnaute Barbatruc

robertduval

XLDnaute Junior

fanch55

XLDnaute Barbatruc

robertduval

XLDnaute Junior

robertduval

XLDnaute Junior

soan

XLDnaute Barbatruc

Pièces jointes

fanch55

XLDnaute Barbatruc

robertduval

XLDnaute Junior

robertduval

XLDnaute Junior

Pièces jointes

fanch55

XLDnaute Barbatruc

soan

XLDnaute Barbatruc

robertduval

XLDnaute Junior

robertduval

XLDnaute Junior

soan

XLDnaute Barbatruc

Pièces jointes

Discussions similaires