Macro insertion de ligne suivant 2 variables

[Franzis]

Salut tout le monde,

Je souhaiterai pouvoir exécuter une macro qui permette d’insérer, pour chaque ligne, un nombre de lignes suivant 2 variables (qui changent à chaque ligne), tout en recopiant les données de la ligne initiale.
Cela fait déjà quelque temps que je m'arrache les cheveux dessus et mon niveaux en VBA est faible, pourriez vous m'aider svp ?
Je pense que l'exemple joint décrit assez bien le processus recherché.

Merci 🙂

 

[Modeste]

Re : Macro insertion de ligne suivant 2 variables

Bonjour Franzis et bienvenue,

Essaie ce code, à placer dans un module standard:

Sub combine()
Set src = Sheets("Sheet1")
For lig = 2 To src.Cells(src.Rows.Count, 2).End(xlUp).Row
    tit2 = Split(src.Cells(lig, 2), ",")
    tit5 = Split(src.Cells(lig, 5), ",")
    With Sheets("Sheet2")
        For t5 = 0 To UBound(tit5)
            For t2 = 0 To UBound(tit2)
                ligne = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
                .Cells(ligne, 1) = src.Cells(lig, 1)
                .Cells(ligne, 2) = Trim(tit2(t2))
                .Cells(ligne, 5) = Trim(tit5(t5))
            Next t2
        Next t5
    End With
Next lig
End Sub

 

[Staple1600]

Re : Macro insertion de ligne suivant 2 variables

Bonjour à tous

Comme quoi toujours boire son café et son jus d'orange avant de commencer à titiller son VBE.

Je m'auto-flagelle en publiant quand même mes piètres essais qui en plus ne faisaient qu'insérer des lignes.

Puis je me console en lisant le code fluide de Modeste que je salue au passage 😉

Sub z()
Dim r&, nbL&
On Error GoTo ToGo
Application.EnableEvents = False
Application.ScreenUpdating = False
For r = Cells(Rows.Count, 2).End(xlUp).Row To 1 Step -1
nbL = (UBound(Split(Cells(r, 2), ",")) + 1) * (UBound(Split(Cells(r, "E"), ",")) + 1)
Cells(r + 1, 1).Resize(nbL, 1).EntireRow.Insert
Cells(r, 1).Resize(nbL, 8).FillDown
Next r
ToGo:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Sub menage()
ActiveSheet.Columns("B:B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

 

[Modeste]

Re : Macro insertion de ligne suivant 2 variables

Salut JM 😀

Je m'auto-flagelle [...]

En même temps, si, à chaque erreur, tu pars au ToGo, tu ne te simplifies pas la tâche 😉

Profitons-en pour signaler à Franzis que si, dans la réalité, le volume de données à traiter est nettement plus conséquent, il faudra certainement adapter le code, dont la prétendue fluidité sera plus mythique encore 🙄

 

[Franzis]

Re : Macro insertion de ligne suivant 2 variables

🙂 Super ! Merci beaucoup !
Juste une dernière chose : quelle est la manipulation à effectuer afin d’insérer, les lignes à ajouter et les données a copier, directement dans le tableau initial ?
(cf. exemple2 ci joint)

 

[job75]

Re : Macro insertion de ligne suivant 2 variables

Bonjour Franzis, bienvenue sur XLD,

La macro dans le fichier joint :

Sub InsertLignes()
Dim t, ncol%, col1%, col2%, sep$
Dim i&, s1, s2, ub1%, ub2%, h%, rest(), j%, n&, k%
t = Sheets("Sheet1").[A1].CurrentRegion 'matrice, plus rapide
ncol = UBound(t, 2)
col1 = 2: col2 = 5 'colonnes à étudier
sep = "," 'séparateur
For i = 1 To UBound(t)
  s1 = Split(Replace(t(i, col1), " ", ""), sep)
  s2 = Split(Replace(t(i, col2), " ", ""), sep)
  ub1 = UBound(s1): ub2 = UBound(s2)
  h = IIf(ub1 > 0, ub1 + 1, 1) * IIf(ub2 > 0, ub2 + 1, 1)
  ReDim Preserve rest(1 To ncol, 1 To n + h)
  For j = 1 To h
    For k = 1 To ncol
      rest(k, n + j) = t(i, k)
    Next
    If ub1 > 0 Then rest(col1, n + j) = s1((j - 1) Mod (ub1 + 1))
    If ub2 > 0 Then rest(col2, n + j) = s2(Int((j - 1) / (ub1 + 1)))
  Next
  n = n + h
Next
rest = Application.Transpose(rest) 'limité à 65536 lignes
With Sheets("Restitution")
  .[A1].Resize(UBound(rest), ncol) = rest
  .Activate
End With
End Sub

La macro est rapide car elle est utilise des tableaux VBA.

S'il faut plus de 65536 lignes, dites-le, on peut transposer le tableau autrement.

A+

 

[job75]

Re : Macro insertion de ligne suivant 2 variables

Re,

Je n'avais pas vu Modeste et Jean-Marie, salut les amis.

🙂Juste une dernière chose : quelle est la manipulation à effectuer afin d’insérer, les lignes à ajouter et les données a copier, directement dans le tableau initial ?

Dans ma macro, à la fin, remplacer Sheets("Restitution") par Sheets("Sheet1") c'est tout.

A+

 

[Modeste]

Re : Macro insertion de ligne suivant 2 variables

Re-bonjour,
Salut job 🙂

S'il s'agit "d'écraser" les données de départ, un tableau devient incontournable.
Et s'il faut recopier les nombres des colonnes I et J sur la première ligne de chaque série (et des 0 ailleurs), une adaptation de ma première proposition:

Sub combine()
Set src = Sheets("Sheet1")
Dim tablo()
For lig = 2 To src.Cells(src.Rows.Count, 2).End(xlUp).Row
    tit2 = Split(src.Cells(lig, 2), ",")
    tit5 = Split(src.Cells(lig, 5), ",")
    first = True
        For t5 = 0 To UBound(tit5)
            For t2 = 0 To UBound(tit2)
                ReDim Preserve tablo(9, ligne)
                tablo(0, ligne) = src.Cells(lig, 1)
                tablo(1, ligne) = Trim(tit2(t2))
                tablo(4, ligne) = Trim(tit5(t5))
                tablo(8, ligne) = IIf(first, src.Cells(lig, 9), 0)
                tablo(9, ligne) = IIf(first, src.Cells(lig, 10), 0)
                first = False
                ligne = ligne + 1
            Next t2
        Next t5
Next lig
src.[A2].Resize(Application.CountA(src.[A:A]), 10).Clear
src.Cells(2, 1).Resize(ligne, 10) = Application.Transpose(tablo)
End Sub

 

[Franzis]

Re : Macro insertion de ligne suivant 2 variables

Bonjour,

Un grand merci à tous, j'ai réussi à adapter la macro à mon tableau. Cela fonctionne très bien.

Bonne semaine a tous !
Encore merci a+ !

 

[Franzis]

Re : Macro insertion de ligne suivant 2 variables

Encore moi...
Je ne comprends pourquoi la ligne (en rouge) se met en erreur sur la macro suivante :
Est ce a cause d'une mauvaise écriture ou est ce parce qu'il n'est pas possible d'effectuer l’opération avec une plage de cellules renommées ?

Sub Insert()
Dim plage As Range
Dim tablo()
Dim ligne As Integer
Set plage = Application.InputBox(prompt:="selectionner la zone", Title:="zone", Left:=3, Top:=-80, Type:=8)
For lig = 2 To plage.Cells(plage.Rows.Count, 2).End(xlUp).Row
tit3 = Split(plage.Cells(lig, 3), ",")
tit5 = Split(plage.Cells(lig, 5), ",")
first = True
For t5 = 0 To UBound(tit5)
For t3 = 0 To UBound(tit3)
ReDim Preserve tablo(9, ligne)
tablo(0, ligne) = plage.Cells(lig, 1)
tablo(1, ligne) = plage.Cells(lig, 2)
tablo(2, ligne) = Trim(tit3(t3))
tablo(4, ligne) = Trim(tit5(t5))
tablo(8, ligne) = IIf(first, plage.Cells(lig, 9), 0)
tablo(9, ligne) = IIf(first, plage.Cells(lig, 10), 0)
first = False
ligne = ligne + 1
Next t3
Next t5
Next lig
plage.[1,1].Resize(Application.CountA(plage.[A:A]), 10).Clear
plage.Cells(1, 1).Resize(ligne, 10) = Application.Transpose(tablo)
End Sub

 

[Modeste]

Re : Macro insertion de ligne suivant 2 variables

Bonjour Franzis, le fil, le forum, la France, l'Europe, le Monde, l'Univers et au-delà (allez savoir! 🙄)

On ne sait pas trop si les modifications que tu as faites sont volontaires et mûrement réfléchies 😕 (d'abord parce qu'on ne connaît pas ton niveau et parce qu'il y a des choses surprenantes)

La ligne où figure l'erreur pourrait nous servir de terrain au jeu des sept erreurs 😀: chez moi, plage se nommait src (jusque là, pas de souci!). Elle représentait une feuille chez moi; elle est devenue une plage de cellules! Ici encore, il y a des choses qui pourraient encore fonctionner ... Mais lorsque tu écris "plage.[1,1]" à quoi veux-tu précisément faire référence? La première cellule de la plage? Et pour faire quoi? Dans ma proposition, j'utilisais cette instruction, une fois le tableau chargé en mémoire, pour effacer les données de départ. Mais toi, tu demandes à l'utilisateur de sélectionner une plage, au départ ... si c'est celle-là qu'il faut effacer, un simple "plage.Clear" devrait suffire, me semble-t-il?? Pourquoi redimensionner cette plage? 😕
En tout état de cause, il ne faut pas confondre les parenthèses avec les crochets: on ne peut pas utiliser les unes ou les autres, à sa meilleure convenance 🙂 Si tu utilises des crochets, il faut utiliser une notation de type [A1], [A:A] ou [A1:B5] ... dans ces deux derniers exemples, on n'utilise pas de virgule, mais un double-point.

Si tu coinces, précise ce que tu voudrais faire précisément ... on essaiera alors de déterminer comment l'écrire

 

[Franzis]

Re : Macro insertion de ligne suivant 2 variables

Merci Modeste,

en faite je voudrais que l'utilisateur puisse sélectionner uniquement la plage ou il a besoin d’insérer les lignes. Car chaque jour de nouvelles données sont susceptibles de rentrer et donc je voulais éviter qu'à chaque fois cela supprime les précédentes lignes, et donc que ça ne s'applique qu'à la plage sélectionnée.
Donc oui effectivement plage.clear (c’était évident :/), et donc il me manque l'ecriture pour pouvoir inserer le tablo à la place de plage

PS : mon niveau n'est pas bon ...(je comprends bien la logique des algorithmes mais je n'ai aucune notion en ce qui concerne le language VBA...).

 

[Modeste]

Re : Macro insertion de ligne suivant 2 variables

Re,

À mon sens il aurait cent fois mieux valu présenter la problématique dans son ensemble, dès le départ! Faute de quoi, en adaptant les choses au fur et à mesure, en brodant, en collant par-dessus, etc. tu vas finir par créer une "usine à gaz" qui risque, en outre, de ne fonctionner que "sur trois pattes" 🙁

De ce que je comprends de ta nouvelle demande, il faudrait insérer ce fameux tableau dans les données existantes!? En préservant certaines lignes au-dessus et en décalant vers le bas, celles qui seraient sous la plage!?

Il faudrait (mais ce n'est que mon point de vue!) que tu fasses un topo complet: quelle est la situation de départ, à un (ou plusieurs?) moment-clé l'utlisateur doit pouvoir faire une série de manipulations (que tu décrirais de manière aussi complète et exhaustive que possible: il y a peut-être une autre approche envisageable, à laquelle tu n'aurais pas songé et qui pourrait être préférable 😕)

 

[Franzis]

Re : Macro insertion de ligne suivant 2 variables

Oui d'accord,
Donc le but est bien d'insérer le tableau dans les données existantes, en préservant toutes les lignes au-dessus et en bas. C'est pour cela que j'ai pensé à la sélection d'une plage. Les colonnes A et C seront remplies manuellement avant chaque lancement de la macro.
Ci-joint un nouvel exemple un peu plus précis.

 

[Modeste]

Re : Macro insertion de ligne suivant 2 variables

Bonjour,

Alors, si ça c'est un topo complet, je n'ose imaginer ce qu'aurait été un résumé!

Je ne sais pas ce que sont devenues les colonnes avec les chiffres à droite dans les exemples précédents? Je ne sais pas non plus ce qu'il faut faire des autres données de la "plage" (les cellules vides de l'exemple)?

Je rappelle que les manipulations réalisées par macro ne peuvent être annulées (sauf en fermant le fichier sans enregistrer). En cas d'erreur de manipulation ... tu assumeras 😱

À tester (mais ce sera ma dernière!)

Sub combine()
Set src = Sheets("Tableau principal")
Dim tablo()
Set plage = Application.InputBox(prompt:="selectionner la zone", Title:="zone", Left:=3, Top:=-80, Type:=8)
debsel = plage.Cells(1, 1).Row
finSel = debsel + plage.Rows.Count - 1
For lig = debsel To finSel
    tit2 = Split(src.Cells(lig, 3), ",")
    tit5 = Split(src.Cells(lig, 5), ",")
    first = True
        For t5 = 0 To UBound(tit5)
            For t2 = 0 To UBound(tit2)
                ReDim Preserve tablo(9, ligne)
                tablo(0, ligne) = src.Cells(lig, 1)
                tablo(1, ligne) = Trim(tit2(t2))
                tablo(4, ligne) = Trim(tit5(t5))
                tablo(8, ligne) = IIf(first, src.Cells(lig, 9), 0)
                tablo(9, ligne) = IIf(first, src.Cells(lig, 10), 0)
                first = False
                ligne = ligne + 1
            Next t2
        Next t5
Next lig
plage.Rows.Delete
src.Cells(debsel, 1).Resize(ligne, 1).EntireRow.Insert
src.Cells(debsel, 1).Resize(ligne, 10) = Application.Transpose(tablo)
End Sub