XL 2013 Supprimer la dernière ligne selont le temps précédent

lestoiles1 · 28 Août 2024

Bonjour ,

J'aimerais supprimer la dernière ligne si le decalage de temps avec le temps précedent est inferieur à 3 sécondes.

Merci d'avance

Lestoiles1

job75 · 29 Août 2024

Bonjour lestoiles1, le forum,

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim t
If Target.Column > 1 Or Target.Row = 1 Then Exit Sub
Application.EnableEvents = False
If Target(1) = "" Then
    Target(1, 2) = ""
Else
    t = Now
    If Target(1) = Target(0, 1) And _
        t < Application.Max(Columns(2)) + 3 / 86400 _
            Then Target.EntireRow.Delete Else Target(1, 2) = t
End If
Application.EnableEvents = True
End Sub

A+

job75 · 28 Août 2024

Bonjour lestoiles1,

MFC sur la colonne A avec police blanche :

Code:

=B1-DECALER(B1;-1;)<3/86400

A+

lestoiles1 · 28 Août 2024

job75 à dit:
Bonjour lestoiles1,

MFC sur la colonne A avec police blanche :

Code:

=B1-DECALER(B1;-1;)<3/86400

A+

Merci job75 mais c'est un macro qui supprime la ligne entière que je veux.

job75 · 28 Août 2024

Vous devriez être capable de faire une boucle en commençant par la fin non ?

lestoiles1 · 28 Août 2024

job75 à dit:
Vous devriez être capable de faire une boucle en commençant par la fin non ?

A vrai dire, c'est un barcode qu'on dois scanner et ça dois etre automatique que la ligne soit supprimer car parfois il y a double scanne(moins de 3 sec)

job75 · 28 Août 2024

Si vous voulez qu'entre 2 entrées il s'écoule au moins 3 secondes modifiez votre code :

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim t
If Target.Column > 1 Or Target.Row = 1 Then Exit Sub
Application.EnableEvents = False
If Target(1) = "" Then
    Target(1, 2) = ""
Else
    t = Now
    If t < Application.Max(Columns(2)) + 3 / 86400 Then Target.EntireRow.Delete Else Target(1, 2) = t
End If
Application.EnableEvents = True
End Sub

lestoiles1 · 28 Août 2024

job75 à dit:

Si vous voulez qu'entre 2 entrées il s'écoule au moins 3 secondes modifiez votre code :

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim t
If Not Target.Address Like "$A$*" Or Target.Row = 1 Then Exit Sub
If Target(1) = "" Then
    Target(1, 2) = ""
Else
    t = Now
    If t < Application.Max(Columns(2)) + 3 / 86400 Then Target.EntireRow.Delete Else Target(1, 2) = t
End If
End Sub

C'est super, merci

job75 · 28 Août 2024

Au post #6 je viens d'ajouter les Application.EnableEvents.

lestoiles1 · 29 Août 2024

job75 à dit:
Au post #6 je viens d'ajouter les Application.EnableEvents.

Merci Job75,
Une derniere condition, si dans les 2 derniere cellules de la colonne A ne sont pas identiques, donc on ne supprime pas la derniere colonne car parfois le scanne passe tres vite.

job75 · 29 Août 2024

Bonjour lestoiles1, le forum,

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim t
If Target.Column > 1 Or Target.Row = 1 Then Exit Sub
Application.EnableEvents = False
If Target(1) = "" Then
    Target(1, 2) = ""
Else
    t = Now
    If Target(1) = Target(0, 1) And _
        t < Application.Max(Columns(2)) + 3 / 86400 _
            Then Target.EntireRow.Delete Else Target(1, 2) = t
End If
Application.EnableEvents = True
End Sub

A+

XL 2013 Supprimer la dernière ligne selont le temps précédent

lestoiles1

XLDnaute Occasionnel

Pièces jointes

job75

job75

XLDnaute Barbatruc

Pièces jointes

lestoiles1

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

lestoiles1

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

lestoiles1

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

lestoiles1

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

Discussions similaires

XL 2013 Supprimer la dernière ligne selont le temps précédent

XLDnaute Occasionnel

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency