Insertion automatique de ligne vide entre plusieurs heures

[johanexcel]

Bonjour à tous, me voila tout nouveau sur ce forum! J'espère donc y trouver mon bonheur.

Je vous explique. J'ai un tableau contenant une suite d'heure au format hh:mm:ss dans la colonne A.
Normalement chaque ligne devrais faire +1min par rapport à la précédente(cf exemple).
Je voudrais que lorsque la différence entre 2 ligne n'est plus égale à une minute, une ligne vide s'insere automatiquement entre les deux.
Je sais que sa se gère par macro j'ai vu des sujet semblable mais ils ne géraient pas le problème de l'heure en plus.
J'espère avoir été claire dans mon explication


Merci d'avance!!

 

[Efgé]

Re : Insertion automatique de ligne vide entre plusieurs heures

Re à tous
EDIT Un problème... à revoir...
EDIT2 J'ai une autre idée mais sans plus de précisions....
Avec les données obligatoirement triées.
Les doublons sont supprimés et les lignes manquantes ajoutées.

Sub Lignes2()
Const M As Double = 1 / 1440
Dim i&, T!, R As Range
T = 1
Application.ScreenUpdating = False
With Sheets("Feuil1")
    For i = .Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
        'Ajout
        If Format(.Cells(i, 1).Value, "hh:mm:00") <> Format(T, "hh:mm:00") Then
            .Rows(i + 1).Insert
            .Cells(i + 1, 1).Value = Format(T, "hh:mm:00")
            .Cells(i + 1, 1).Interior.ColorIndex = 35
            i = i + 1
        ' Doublon
        ElseIf Format(.Cells(i, 1).Value, "hh:mm:00") = _
                Format(.Cells(i - 1, 1).Value, "hh:mm:00") Then
            Set R = Union(.Rows(i), IIf(R Is Nothing, Rows(i), R))
            T = T + M
        End If
        T = T - M
    Next i
    While Format(.Cells(2, 1).Value, "hh:mm:00") <> "00:00:00"
        .Rows(2).Insert CopyOrigin:=xlFormatFromRightOrBelow
        .Cells(2, 1).Value = Format(T, "hh:mm:00")
        .Cells(2, 1).Interior.ColorIndex = 35
        T = T - M
    Wend
    If Not R Is Nothing Then R.Select ' Pour visualiser la plage
    'If Not R Is Nothing Then R.Delete ' pour supprimer la plage
End With
Application.ScreenUpdating = True
End Sub

Cordialement