Mettre l'heure dans une cellule si elle est égale à 1

[yves211]

Bonsoir tout le monde?

J'ai regardé sur le forum et j'ai bien trouvé des discussions sur les heures. Toutes avec des macros à ne plus en finir. J'ai déjà du mal à "déclarer" un module !!
J'ai fait une petite application très très simple.

Pour le nom de l’opérateur, j'ai trouvé un générateur de codes à barres gratuit. j'ai créé un code personnalisé à chaque opérateur qui va en A1

- J'utilise une scannete et je met le code en cellule B1
- Et la cellule C1 affiche 1 (pour quantifier )
- Mais je voudrais que la cellule D1 affiche l'heure et quelle ne bouge pas.
- J'ai bien fait Ctrl : ça fonctionne bien. Mais j'aurais préféré en automatique.
- J'ai donc fait =si(C1 ="","",maintenant())
Ça fonctionne mais l'heure tourne, elle n'est pas fixe

Pourriez-vous dire comment je peux faire pour que l'heure reste fixe après chaque scanage de l'opérateur

En vous remerciant par avance

 

[chris]

Bonjour

Voir ci-joint

 

[job75]

Bonjour yves211, chris,

Sujet maintes fois traité.

Ceci permet les entrées ou effacements multiples :

Private Sub Worksheet_Change(ByVal Target As Range)
Set Target = Intersect(Target, Range("E6:E" & Rows.Count), UsedRange)
If Target Is Nothing Then Exit Sub
For Each Target In Target 'si entrées/effacements multiples
    Target(1, 3) = IIf(Target = "", "", Now)
Next
End Sub

Bonne journée.

 

[Jocelyn]

Bonjour le Forum,
Bonjour yves211, Chris ,

Principalement pour saluer Chris, et pour le fun proposer une solution formule en ayant activé le calcul itératif

Mettre en G6 et étirer vers le bas

=SI(F6<>1;"";SI(G6="";MAINTENANT();G6))

voir fichier

Cordialement

Bises Chris

EDIT : Bonjour job75

 

[job75]

Re, bonjour Jocelyn,

La macro du post #3 est très lente sur une grande plage car les cellules sont traitées une par une.

Par exemple la copie de E6 sur E7:E20000 prend 25 secondes chez moi.

Pour aller vite il faut utiliser un tableau VBA, la copie s'exécute alors en 0,35 seconde :

Private Sub Worksheet_Change(ByVal Target As Range)
Set Target = Intersect(Target, Range("E6:E" & Rows.Count), UsedRange)
If Target Is Nothing Then Exit Sub
Dim t, i&
If FilterMode Then ShowAllData 'si la feuille est filtrée
For Each Target In Target.Areas 'si entrées/effacements multiples
    If Target.Count = 1 Then
        Target(1, 3) = IIf(Target = "", "", Now)
    Else
        t = Target 'tableau VBA, plus rapide
        For i = 1 To UBound(t)
            t(i, 1) = IIf(t(i, 1) = "", "", Now)
        Next i
        Target.Offset(, 2) = t 'restitution
    End If
Next Target
End Sub

Fichier (2).

A+

 

[job75]

Re,

En fait le traitement des cellules une par une est assez rapide si l'on ajoute les Application.EnableEvents :

Private Sub Worksheet_Change(ByVal Target As Range)
Set Target = Intersect(Target, Range("E6:E" & Rows.Count), UsedRange)
If Target Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each Target In Target 'si entrées/effacements multiples
    Target(1, 3) = IIf(Target = "", "", Now)
Next
Application.EnableEvents = True
End Sub

La copie de E6 sur E7:E20000 se fait maintenant en 0,70 seconde chez moi.

Fichier (1 bis).

Bonjour Pierre, merci pour le Like

A+

 

[chris]

Bonjour

...
Principalement pour saluer Chris...
Bises Chris

Bises à toi également Jocelyn

 

[yves211]

Bonjour tout le monde.
Je remercie toutes les personnes qui m'ont permis d'avancer dans mon travail, et je les remercie pour leur temps passer à me dépanner. J'ai bien trouvé des macros mais quand on est "une quiche" on reste "une quiche", mais je vais essayer de l'appliquer dans un autre fichier .

Je vous souhaite une bonne soirée à toutes et à tous , en vous remerciant encore.

Yves