XL 2010 Personnalisation cellules suite insertion de lignes en fonction d'une valeur

[thomasdu43]

Bonjour,
J'ai vu plusieurs posts sur l'insertion de lignes en fonction de la valeur d'une cellule sépcifique.
Je souhaiterai que le contenu d'une cellule de ces lignes insérées soit défini par avance. Exemple dans le fichier joint, si j'inscris la valeur "oui" en B3 et le résultat est la création de 4 lignes dont le contenu de la cellule A4, A5, A6 et A7 est respectivement "Enfant 1", "Enfant 2", "Enfant 3", "Enfant 4".

Je vous remercie de votre aide.

A bientôt

 

[Calvus]

Bonjour,

Voir l'exemple joint si j'ai bien compris la demande.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Byte
If Not Intersect(Range("B1:B" & Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row), Target) Is Nothing And Target.Count = 1 Then
        If Target = "Oui" Then
            For i = 1 To 4
                Target.Offset(i, 0).EntireRow.Insert
                Target.Offset(i, -1) = "Enfant " & i
            Next i
        End If
End If
End Sub

A+

 

[job75]

Bonjour thomasdu43, Calvus,

Il y a peu de réponses car c'est assez compliqué, j'ai dû m'y reprendre à plusieurs fois.

S'il y a beaucoup de lignes il faut utiliser des tableaux VBA pour aller vite :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ncol%, tablo, ub&, i&, n&, j%, k&
With UsedRange
    ncol = .Columns.Count
    If ncol = 1 Then ncol = 2 'sécurité
    tablo = .Resize(.Rows.Count + 1, ncol)
    ub = UBound(tablo) - 1
    ReDim resu(1 To UBound(tablo) + 4 * Application.CountIf(.Columns(2), "Oui"), 1 To ncol)
    For i = 1 To UBound(tablo) - 1
        If Not LCase(tablo(i, 1)) Like "enfant#" Then
            n = n + 1
            For j = 1 To ncol
                resu(n, j) = tablo(i, j)
            Next j
            If LCase(tablo(i, 2)) = "oui" Then
                If LCase(tablo(i + 1, 1)) Like "enfant#" Then
                    For k = i + 1 To ub
                        n = n + 1
                        For j = 1 To ncol
                            resu(n, j) = tablo(k, j)
                        Next j
                        If Not LCase(tablo(k, 1)) Like "enfant#" Then Exit For
                    Next
                    i = k
                Else
                    For k = 1 To 4
                        n = n + 1
                        resu(n, 1) = "Enfant" & k
                    Next k
                End If
            End If
        End If
    Next i
    Application.ScreenUpdating = False
    Application.EnableEvents = False 'désactive les évènements
    If FilterMode Then ShowAllData 'si la feuille est filtrée
    .Value = Empty 'RAZ
    .Cells(1).Resize(n, ncol) = resu 'restitution
    Application.EnableEvents = True 'réactive les évènements
End With
With UsedRange: End With 'actualise les barres de défilement
End Sub

Fichier joint, sur 60 000 lignes initiales (140 000 finales) la macro s'exécute chez moi en 1,5 seconde.

A+

 

[Calvus]

Bonjour Job75, le fil,

J'espère que tu vas bien

Il y a peu de réponses car c'est assez compliqué

Toujours aussi impressionnants tes codes !

Tu penses que ma solution ne fonctionne pas dans le cas d'une centaine de lignes ou quelques centaines ?

A+

 

[job75]

Tout dépend de ce que l'on veut faire Calvus, ta solution peut suffire mais elle est très incomplète :

- elle ne fonctionne que si une seule cellule est modifiée

- si l'on remplace le "Oui" par "Non" les "Enfant?" ne s'effacent pas

- si l'on remet le "Oui" on aura 8 "Enfant?"...

A+

 

[Calvus]

Re,

Oui c'est vrai...
Mais en même temps, il est difficile d'avoir des enfants, puis de ne plus en avoir, puis d'avoir à nouveau...

 

[thomasdu43]

Bonjour,

Voir l'exemple joint si j'ai bien compris la demande.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Byte
If Not Intersect(Range("B1:B" & Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row), Target) Is Nothing And Target.Count = 1 Then
        If Target = "Oui" Then
            For i = 1 To 4
                Target.Offset(i, 0).EntireRow.Insert
                Target.Offset(i, -1) = "Enfant " & i
            Next i
        End If
End If
End Sub

A+

Merci Calvus, c'est ça, maintenant y a-t-il une possibilité de réversibilité si je saisis "non" ?

 

[job75]

Merci Calvus, c'est ça, maintenant y a-t-il une possibilité de réversibilité si je saisis "non" ?

Comme indiqué au post #5 Calvus aura du mal.