robertduval
XLDnaute Junior
Bonjour je souhaiterais une colonne compteur qui suivant la valeur additionne ou remet a zero Merci
XL 2016 Compteur avec conditions
- Initiateur de la discussion robertduval
- Date de début
Solution
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 :
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
Bonjour,
En espérant que quelqu'un vienne me contredire,
je pense que votre demande est impossible à satisfaire par formule .
En espérant que quelqu'un vienne me contredire,
je pense que votre demande est impossible à satisfaire par formule .
robertduval
XLDnaute Junior
Ah ok tant pis et en vba avez vous une solution Merci
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
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 Subrobertduval
XLDnaute Junior
Bonjour comment j'active ce programme ou comment fonctionne t'il Merci
Bonjour Robert, fanch,
ton fichier en retour.
* ta formule en B2 pouvait être simplifiée en :
* 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 :
soan
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 Subsoan
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
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
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 
je dis pas comme ça vous restez amis c'est incroyable ce site, vous êtes hyper réactif, longue vie a ce forum 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
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
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
, 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 2robertduval
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
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
Discussions similaires
- Question
