XL 2013 saut de ligne après un critère défini (date)

[chac10]

Bonjour à tous,

Est ce que quelqu'un saurait comment demander en vba ceci :

J'ai une liste de date, avec plusieurs années ( 2019 / 2020 /2021) :il faudrait insérer deux lignes après chaque année.
Ca donnerait ceci

Départ :

01/02/2019
01/03/2019
01/02/2020
01/03/2020
01/02/2021
01/03/2021

Avec VBA :

01/02/2019
01/03/2019


01/02/2020
01/03/2020


01/02/2021
01/03/2021

 

[M12]

Bonjour
Un test

 

[chac10]

Bonjour,

Je pense qu'il y a un problème dans ton fichier.
On m'indique la présence d'un trojan.

 

[M12]

Re,
Désolé, mais mon Kasperky ne trouve rien

 

[job75]

Bonjour chac10, M12,

Il vaut mieux utiliser des tableaux VBA, c'est plus rapide s'il y a beaucoup de lignes :

Sub Inserer()
Dim resu(), tablo, i&, dat, n&
Application.ScreenUpdating = False
With Feuil1 'CodeName
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    ReDim resu(1 To .Rows.Count, 1 To 1)
    With .Range("G3:G" & .Cells.SpecialCells(xlCellTypeLastCell).Row) 'plage à adapter
        .Sort .Columns(1), xlAscending, Header:=xlNo 'tri
        tablo = .Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
        For i = 1 To UBound(tablo)
            dat = tablo(i, 1)
            If IsDate(dat) Then
                n = n + 1
                If i > 1 Then If IsDate(tablo(i - 1, 1)) Then If Year(dat) <> Year(tablo(i - 1, 1)) Then n = n + 2
                resu(n, 1) = tablo(i, 1)
            End If
        Next
        If n Then .Resize(n) = resu 'restitution
    End With
End With
End Sub

A+

 

[chac10]

Bonjour,

Je pense qu'il y a un problème dans ton fichier.
On m'indique la présence d'un trojan.


Regarde la pièce jointe 1110960

Bonjour chac10, M12,

Il vaut mieux utiliser des tableaux VBA, c'est plus rapide s'il y a beaucoup de lignes :

Sub Inserer()
Dim resu(), tablo, i&, dat, n&
Application.ScreenUpdating = False
With Feuil1 'CodeName
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    ReDim resu(1 To .Rows.Count, 1 To 1)
    With .Range("G3:G" & .Cells.SpecialCells(xlCellTypeLastCell).Row) 'plage à adapter
        .Sort .Columns(1), xlAscending, Header:=xlNo 'tri
        tablo = .Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
        For i = 1 To UBound(tablo)
            dat = tablo(i, 1)
            If IsDate(dat) Then
                n = n + 1
                If i > 1 Then If IsDate(tablo(i - 1, 1)) Then If Year(dat) <> Year(tablo(i - 1, 1)) Then n = n + 2
                resu(n, 1) = tablo(i, 1)
            End If
        Next
        If n Then .Resize(n) = resu 'restitution
    End With
End With
End Sub

A+

Bonjour JOB75,

Merci beaucoup pour votre aide. J'essaie d'intégrer le code.
Je vous dis si j'y arrive.
Chac10.