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

chac10

XLDnaute Junior
Supporter XLD
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
 

Pièces jointes

  • tets.xlsx
    8.4 KB · Affichages: 9

chac10

XLDnaute Junior
Supporter XLD
Bonjour,

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


1626252578171.png
 

job75

XLDnaute Barbatruc
Bonjour chac10, M12,

Il vaut mieux utiliser des tableaux VBA, c'est plus rapide s'il y a beaucoup de lignes :
VB:
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+
 

Pièces jointes

  • Insérer(1).xlsm
    17.6 KB · Affichages: 3
Dernière édition:

chac10

XLDnaute Junior
Supporter XLD
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 :
VB:
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.
 

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
294 371
Messages
1 938 081
Membres
188 641
dernier inscrit
pcayet