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

  • Initiateur de la discussion Initiateur de la discussion chac10
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

chac10

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

Bonjour,

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


1626252578171.png
 
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

Dernière édition:
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.
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
18
Affichages
4 K
Réponses
12
Affichages
1 K
Retour