Insérer une ligne vide si le mot "Identifiant" est trouvé en colonne "D"

Bonjour à tous,

Mes données se composent comme suit :

13 Colonnes et un certain nombre de lignes variable.

Le code ci-dessous fait le travail en insérant une ligne vide à chaque fois qu’il trouve la mot "Identifiant" dans la colonne "D".

Je me demande s'il n'y a pas moyen de l’optimiser afin qu’il puisse s’exécuter rapidement, à en utilisant soit :

Des arrays, ou des matrices, voire peut-être des dictionnaires.

Merci d’avance de vos propositions.

Sub InsererLigne()
Dim x As Long
Dim startRow As Long
Dim endRow As Long

startRow = 2
endRow = Cells(Rows.Count, "D").End(xlUp).Row

    With Sheets("Accouplements")
        For x = endRow To startRow Step -1
                If .Cells(x, "D").Value = "Identifiant" Then
                    Cells(x, "A").EntireRow.insert Shift:=xlDown
                End If
        Next x
    End With
End Sub

bonjour,

une proposition

Sub InsererLigne()

    Dim x As Long
    Dim startRow As Long
    Dim endRow As Long
    Dim cold, coltri
    Dim ctr
    With Sheets("Accouplements")
        startRow = 1
        endRow = .Cells(Rows.Count, "D").End(xlUp).Row
        ReDim coltri(1 To endRow * 2, 1 To 1)
        .Columns("E:E").Insert Shift:=xlRight
        cold = .Range("D1").Resize(endRow, 1)
        ctr = endRow
        For x = 1 To endRow
            coltri(x, 1) = x
            If cold(x, 1) = "Identifiant" Then
                ctr = ctr + 1
                coltri(ctr, 1) = x - 0.1 'pour insérer la ligne avant -, pour insérer la ligne après +
            End If
        Next x
        .Range("E1").Resize(ctr, 1) = coltri
        .UsedRange.Sort key1:=.Range("E1"), order1:=xlAscending, Header:=xlNo
        .Columns("E:E").Delete Shift:=xlToLeft
    End With

End Sub

Bonjour H2SO4,

Merci pour votre retour et le code proposé.

Dans ma Macro, je commence à partir de la 2e ligne car je souhaite garder la première ligne inchangée.

Votre code, commence à la première ligne, du coup, le résultat final souhaité ne correspond pas à ce que je souhaite .

Je mets à votre disposition mon fichier avec une toute petite partie de la feuille concernée, afin que puissiez-vous rendre compte que la première ligne à été modifiée.

Cordialement.

rebonjour,

code adapté

Sub InsererLigne2()     'Votre Macro

    Dim x As Long
    Dim startRow As Long
    Dim endRow As Long
    Dim cold, coltri
    Dim ctr
    With Sheets("Accouplements")
        startRow = 2
        endRow = .Cells(Rows.Count, "D").End(xlUp).Row
        ReDim coltri(1 To endRow * 2, 1 To 1)
        .Columns("E:E").Insert Shift:=xlRight
        cold = .Range("D1").Resize(endRow, 1)
        ctr = endRow
        For x = startRow To endRow
            coltri(x, 1) = x
            If cold(x, 1) = "Identifiant" Then
                ctr = ctr + 1
                coltri(ctr, 1) = x - 0.1 'pour insérer la ligne avant -, pour insérer la ligne après +
            End If
        Next x
        .Range("E1").Resize(ctr, 1) = coltri
        .UsedRange.Sort key1:=.Range("E1"), order1:=xlAscending, Header:=xlYes
        .Columns("E:E").Delete Shift:=xlToLeft
    End With

End Sub

Bonsoir Harzer, h2so4 , le forum,

Une petite variante...résultat en Feuil1....

Cordialement,

Bonjour H2SO4,

Merci pour l’adaptation du code, cela répond à mes attentes.

Puis-je me permettre une toute dernière adaptation, que je viens de remarquer en faisant mes tests, à savoir :

J’ai cliqué involontairement deux de suite sur le bouton qui déclenche votre Macro, j’ai remarqué qu’il ajoute une autre série de lignes supplémentaires, y’aurait-il moyen de faire un test pour savoir si les lignes vides existent déjà, alors, dans ce cas, de sortir de la boucle et ne pas ajouter d’autres lignes supplémentaires.

Je vous remercie d’avance.

Bonjour xorsankukai et les autres membres,

Merci pour votre proposition, je remarque que le code utilise des tableaux.

Le code répond à mes attentes, le seul inconvénient, il travaille sur une autre feuille supplémentaire, je vous avoues qu’il y’a tellement de feuilles dans mon projet, que je ne souhaite pas ajouter d’autres, y’a-t-il moyen de travailler sur la même feuille nommée "Accouplements"?

Salutations.

Re,

Le code répond à mes attentes, le seul inconvénient, il travaille sur une autre feuille supplémentaire, je vous avoues qu’il y’a tellement de feuilles dans mon projet, que je ne souhaite pas ajouter d’autres, y’a-t-il moyen de travailler sur la même feuille nommée "Accouplements"?

Sub test()
 Dim tb, ntb(), i%, x%, k%
 Application.ScreenUpdating = False

  With Sheets("Accouplements")
   tb = .Range("A1:M" & .UsedRange.Rows.Count)
   k = 0
   ReDim ntb(1 To UBound(tb, 1) * 2, 1 To UBound(tb, 2))
    For i = 1 To UBound(tb, 1)
     If tb(i, 4) Like "Identifiant" Then k = k + 1
      If tb(i, 4) <> "" Then
       For j = 1 To UBound(tb, 2)
        ntb(k + 1, j) = tb(i, j)
       Next j
       k = k + 1
      End If
    Next i

   If k > 0 Then
   .Range("A1:M" & .UsedRange.Rows.Count).Delete: .Cells.FormatConditions.Delete
   .Range("A1").Resize(k, UBound(tb, 2)) = ntb
   .Rows("1:1").Delete: .Columns.AutoFit
   .Range("A1:M" & .UsedRange.Rows.Count).FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=$D1=""Identifiant"""
   .Range("A1:M" & .UsedRange.Rows.Count).FormatConditions(1).Font.Bold = True
  End If
 End With
 Erase tb: Erase ntb
End Sub

Cordialement,

Bonjour xorsankukai, H2SO4 et le forum,

Merci à tous les deux pour vos propositions, elles me donnent satisfactions.

Je suis dans l’impossibilité de choisir l’une ou l’autre proposition, tellement qu’elles sont bien codées toutes les deux.

Merci encore à tous les deux pour votre disponibilité et patience.

Amicalement.

re à tous,

J’ai cliqué involontairement deux de suite sur le bouton qui déclenche votre Macro, j’ai remarqué qu’il ajoute une autre série de lignes supplémentaires, y’aurait-il moyen de faire un test pour savoir si les lignes vides existent déjà, alors, dans ce cas, de sortir de la boucle et ne pas ajouter d’autres lignes supplémentaires.

code adapté (on arrête la procédure si une cellule vide est détectée en colonne D)

Sub InsererLigne2()     'Votre Macro

    Dim x As Long
    Dim startRow As Long
    Dim endRow As Long
    Dim cold, coltri
    Dim ctr
    With Sheets("Accouplements")
        startRow = 2
        endRow = .Cells(Rows.Count, "D").End(xlUp).Row
        ReDim coltri(1 To endRow * 2, 1 To 1)
        .Columns("E:E").Insert Shift:=xlRight
        cold = .Range("D1").Resize(endRow, 1)
        ctr = endRow
        For x = startRow To endRow
            If cold(x, 1) = "" Then Exit For
            coltri(x, 1) = x
            If cold(x, 1) = "Identifiant" Then
                ctr = ctr + 1
                coltri(ctr, 1) = x - 0.1 'pour insérer la ligne avant -, pour insérer la ligne après +
            End If
        Next x
        If x > endRow Then
            .Range("E1").Resize(ctr, 1) = coltri
            .UsedRange.Sort key1:=.Range("E1"), order1:=xlAscending, Header:=xlYes
        End If
        .Columns("E:E").Delete Shift:=xlToLeft
    End With

End Sub

Bonjour H2SO4 et le forum,

Merci pour l’adaptation du code à ma dernière demande.

Le code mis en œuvre répond totalement à ma demande, réagit rapidement et me satisfait totalement.

Cordiale poignée de mains.

Bonjour xorsankukai,

En continuant mes tests, j’ai remarqué que les 3 boutons qui sont disposés à la première ligne disparaissent lorsque je clique sur votre bouton, celui enclenche votre code, je n’avais pas remarqué cette bizarrerie lors de mes premiers tests.

Pourriez-vous regarder d’où le problème provient.

D’avance merci.

Bonsoir à tous,

j’ai remarqué que les 3 boutons qui sont disposés à la première ligne disparaissent lorsque je clique sur votre bouton

Effectivement, le fait de supprimer la première ligne efface les boutons également.

Nouvelle version....on traite à partir de la seconde ligne...

Mais le code de h2so4 me semble plus fiable, je ne peux rivaliser,

Cordialement,

Bonjour xorsankukai,

Il est vraie que le code de H2SO4 est légèrement plus rapide, d’ailleurs, c’est pour cela que je l’ai mis en application dans mon projet.

Toutefois, ça me plait de garder les deux codes, d’autant plus qu’ils sont tous les deux fonctionnels, le vôtre sera gardé juste en dessous du code de H2SO4, et sera commenté en bloc, il sera peut-être utile au besoin pour une utilisation future, On ne sait jamais.

Merci beaucoup pour la mise à jour fonctionnelle pour éviter la suppression de boutons qui commandent les Macros.

Une bonne fin d’année à tous et un bon début, que 2024 vous apporte joie, bonheur et santé.