XL 2016 Compteur avec conditions

fanch55

XLDnaute Barbatruc

• 18 Juillet 2021

• #2

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

 

Vote positif 0 Vote négatif

R

robertduval

XLDnaute Junior

• 18 Juillet 2021

• #3

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

 

Vote positif 0 Vote négatif

fanch55

XLDnaute Barbatruc

• 18 Juillet 2021

• #4

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

 

Vote positif 0 Vote négatif

R

robertduval

XLDnaute Junior

• 18 Juillet 2021

• #5

Merci je vais tester tout ça 😉

 

Vote positif 0 Vote négatif

R

robertduval

XLDnaute Junior

• 19 Juillet 2021

• #6

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

 

Vote positif 0 Vote négatif

S

soan

XLDnaute Barbatruc

Inactif

• 19 Juillet 2021

• #7

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

Vote positif 0 Vote négatif

fanch55

XLDnaute Barbatruc

• 19 Juillet 2021

• #8

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

 

Vote positif 0 Vote négatif

R

robertduval

XLDnaute Junior

• 19 Juillet 2021

• #9

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 🙏

 

Vote positif 0 Vote négatif

R

robertduval

XLDnaute Junior

• 20 Juillet 2021

• #10

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

Vote positif 0 Vote négatif

fanch55

XLDnaute Barbatruc

• 20 Juillet 2021

• #11

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

 

Vote positif 0 Vote négatif

S

soan

XLDnaute Barbatruc

Inactif

• 20 Juillet 2021

• #12

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

 

Vote positif 0 Vote négatif

R

robertduval

XLDnaute Junior

• 21 Juillet 2021

• #13

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

 

Vote positif 0 Vote négatif

R

robertduval

XLDnaute Junior

• 22 Juillet 2021

• #14

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👍

 

Vote positif 0 Vote négatif

S

soan

XLDnaute Barbatruc

Inactif

• 22 Juillet 2021

• #15

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

 

Pièces jointes

• Test.xlsx

  10.2 KB · Affichages: 5

Vote positif 0 Vote négatif