Supprimer lignes

[Luigi]

Bonjour à tous

J’ai un problème pour supprimer des lignes entre deux dates. Dans la colonne B j’ai des dates et dans la colonne C j’ai des heures, ces colonnes peuvent varier en nombre de lignes.
Dans la cellule H1 j’ai la date de début et dans la cellule I1 j’ai l’heure de début.
Dans la cellule H2 j’ai la date de fin et dans la cellule I2 j’ai l’heure de fin.
Je voudrais supprimer via une macro toutes les lignes qui sont à l’extérieur de de mes dates et heures de début et de fin.

Quelqu’un pourrait-il m’aider ces lignes avec les deux variable Date et Heure.

D’avance merci

Ci-joint mon fichier Excel

 

[job75]

Re : Supprimer lignes

Bonjour Luigi,

Voyez cette macro :

Sub Supprime()
Dim deb As Single, fin As Single, d As Single, i As Long
Application.ScreenUpdating = False
deb = Application.Min([H1] + [I1], [H2] + [I2])
fin = Application.Max([H1] + [I1], [H2] + [I2])
For i = [B65536].End(xlUp).Row To 3 Step -1
d = Cells(i, 2) + Cells(i, 3)
If d < deb Or d > fin Then Rows(i).Delete
Next
End Sub

A+

 

[Minick]

Re : Supprimer lignes

Salut,

Comme ceci par exemple:

Option Explicit

Sub SupLigne()
    Dim CptDate As Integer
    Dim DateDeb As Date, DateFin As Date
    Dim HeureDeb As Date, HeureFin As Date

    Application.ScreenUpdating = False
        With Sheets("SupLigne")
            DateDeb = .Range("H1").Value
            HeureDeb = .Range("I1").Value
            DateFin = .Range("H2").Value
            HeureFin = .Range("I2").Value
            
            For CptDate = .Range("B65536").End(xlUp).Row To 3 Step -1
                If .Range("B" & CptDate).Value < DateDeb And .Range("B" & CptDate).Value > DateFin Then
                    .Rows(CptDate).Delete
                Else
                    If .Range("C" & CptDate).Value < HeureDeb And .Range("C" & CptDate).Value > HeureFin Then
                        .Rows(CptDate).Delete
                    End If
                End If
            Next CptDate
        End With
    Application.ScreenUpdating = True
End Sub

++
Minick

 

[Cousinhub]

Re : Supprimer lignes

Bonjour,

Plutôt que de supprimer les lignes, (on n'est jamais trop prudent...), j'extrais vers une autre feuille les lignes qui correspondent à tes critères

regarde le fichier joint...

 

[job75]

Re : Supprimer lignes

Bonjour le fil,

bhbh a tout à fait raison, il est préférable de sauvegarder les lignes avant de les supprimer.

En plus c'est une solution plus rapide, voici ma version :

Sub Supprime()
Dim deb As Single, fin As Single, d As Single, i As Long, plage As Range
Application.ScreenUpdating = False
deb = Application.Min([H1] + [I1], [H2] + [I2])
fin = Application.Max([H1] + [I1], [H2] + [I2])
For i = 3 To [B65536].End(xlUp).Row
d = Cells(i, 2) + Cells(i, 3)
If d < deb Or d > fin Then Set plage = Union(Rows(i), IIf(plage Is Nothing, Rows(i), plage))
Next
If plage Is Nothing Then Exit Sub
plage.Copy Sheets("Extract").[B65536].End(xlUp)(2).Offset(, -1)
plage.Delete
End Sub

A+

 

[Luigi]

Re : Supprimer lignes

Merci à vous tous, vos solution sont parfaite pour moi

A bientôt