Création de X lignes par rapport à une cellule [résolu]

[oxychene]

Bonsoir à tous,

je souhaiterais savoir si il est possible, et si oui comment.

J'ai en colonne CT des valeur tels que 5,9,1... mais tous inférieur à 20.
J'ai besoin de créer autant de lignes que la valeur du nombre.

Par exemple ligne 10 valeur 5,00 lignes à créer à la suite
ligne 11 valeur 4,00 lignes à créer à la suite
ligne 12 valeur 3,00 lignes à créer à la suite
ligne 13 valeur 4,00 lignes à créer à la suite
.... et ceux sur environs 5000 lignes
Bien sur vous allez me dire que la ligne 11 avant création de nouvelle lignes deviendra la ligne 16 à la suite de création des ligne de la ligne 10 (10+5=15 CT11=CT16). Mais cela ne n’importe peu.

En fait c'est parce que mon tableau d'origine fonctionne avec des entrées par colonne.

Je doit changer de logiciel et ce dernier fonctionne par ligne/colonne.

Si vous souhaitez avoir un fichier cela peu être possible mais il est très lourd.

D'avance merci et bon appétit à ceux qui passe à table.

CDT, Oxychene

 

[job75]

Re : Création de X lignes par rapport à une cellule

Bonsoir oxychene,

Insertion avant ou après ?

Choisissez parmi ces 2 macros celle qui vous convient le mieux :

Sub InsereLignesApres()
Dim i&, c As Range
Application.ScreenUpdating = False
For i = Cells(Rows.Count, "CT").End(xlUp).Row To 1 Step -1
  Set c = Cells(i, "CT")
  If IsNumeric(c) Then _
    If CInt(c) > 0 Then c(2).Resize(CInt(c)).EntireRow.Insert
Next
End Sub

Sub InsereLignesAvant()
Dim i&, c As Range
Application.ScreenUpdating = False
For i = Cells(Rows.Count, "CT").End(xlUp).Row To 1 Step -1
  Set c = Cells(i, "CT")
  If IsNumeric(c) Then _
    If CInt(c) > 0 Then c.Resize(CInt(c)).EntireRow.Insert
Next
End Sub

Edit : sur 5000 lignes cela prendra un peu de temps.

Mais a priori la macro ne sera exécutée qu'une fois...

Bonne fin de soirée.

 

[oxychene]

Re : Création de X lignes par rapport à une cellule

Bonsoir à tous, bonsoir job75,

tout d'abord merci.

L'insertion se fait après la cellule de valeur.

Quels vont être les différences entre les deux codes?

Et surtout comment elles s'appliques? (bouton, action...)

J'attend votre réponse et un soir où je ne rentre pas trop tard, je l'essaye.

Encore merci

Cdt

 

[job75]

Re : Création de X lignes par rapport à une cellule

Bonjour oxychene, le forum,

Et surtout comment elles s'appliques? (bouton, action...)

C'est à vous de voir.

Vous pouvez faire lancer la macro par un bouton, un raccourci clavier, un double-clic...

Bonne journée.

 

[oxychene]

Re : Création de X lignes par rapport à une cellule

Bonjour à tous, bonjour job 75,

pour information je viens d'essayer votre macro d'abord avec un raccourci pour déclenchement.

Résultat au bout d'une heure après avoir exécuté la macro, rien d’effectué, puis excel à planté.

Je viens de supprimer la macro pour la recréer tel que vous l'avez écrite.

Je l'ai exécuté depuis l'onglet développeur.

Au bout de cinq secondes je reçois le message VB suivant:

Erreur d'exécution '1004':
La méthode Insert de la classe Range à échoué.

j'ai aussi depuis calculé que les quelques 5000 lignes allaient donner un peu moins de 60000 lignes.

Ou avons nous faux?

Merci et bon week-end à tous

Cdt, oxychene

 

[job75]

Re : Création de X lignes par rapport à une cellule

Bonjour oxychene,

Sans votre fichier pour tester je ne peux rien vous dire.

J'ai testé sans problème ma macro sur un fichier "normal".

A+

 

[job75]

Re : Création de X lignes par rapport à une cellule

Re,

Bien entendu si vous avez des macros évènementielles dans la feuille il faut désactiver les évènements :

Sub InsereLignesApres()
Dim i&, c As Range
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
On Error Resume Next 'sécurité
For i = Cells(Rows.Count, "CT").End(xlUp).Row To 1 Step -1
  Set c = Cells(i, "CT")
  If IsNumeric(c) Then _
    If CInt(c) > 0 Then c(2).Resize(CInt(c)).EntireRow.Insert
Next
Application.EnableEvents = True 'réactive les évènements
End Sub

Normalement On Error Resume Next est inutile...

A+

 

[job75]

Re : Création de X lignes par rapport à une cellule

Re,

Et s'il y a des formules qui se recalculent il faut passer temporairement en mode de calcul manuel :

Sub InsereLignesApres()
Dim i&, c As Range
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
Application.Calculation = xlCalculationManual
On Error Resume Next 'sécurité
For i = Cells(Rows.Count, "CT").End(xlUp).Row To 1 Step -1
  Set c = Cells(i, "CT")
  If IsNumeric(c) Then _
    If CInt(c) > 0 Then c(2).Resize(CInt(c)).EntireRow.Insert
Next
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True 'réactive les évènements
End Sub

A+

 

[oxychene]

Re : Création de X lignes par rapport à une cellule

Bonjour à tous, bonjour à job75,

pour faire suite à la discussion.

En lien le fichier.

Free - Envoyez vos documents

Il à diminué de taille mais est toujours très lourd(10mo).

Dans la feuille mo à partir de la ligne 9 (avant une copie de l'exemple),
se trouve le nombre de ligne à créer "après" en colonne BL.

Espérant avoir répondu a vos attentes pour une suite favorable.

Cordialement

 

[oxychene]

Re : Création de X lignes par rapport à une cellule

A job 75,

je viens de prendre connaissance de vos trois dernier messages. Je n'ai plus de macro dans le dossier.

Au vus de tout ce que j'ai supprimé, je crois qu'il n'y a plus de formule qui se recalcul.

 

[oxychene]

Re : Création de X lignes par rapport à une cellule

Re, à job75,

je viens de copier votre dernière macro que j'ai collé dans excel. J'ai au préalable supprimé les ligne 2 à 7 puis mis les calcul en manuel.

Puis j'ai activé votre macro.

Aucun résultat, j'ai peur que le fichier ne soit toujours trop lourd.

 

[job75]

Re : Création de X lignes par rapport à une cellule

Bonsoir oxychene,

Votre fichier me paraît tout à fait normal.

Simplement il y a beaucoup de données dans la feuille "mo" et la macro que j'ai proposée rame désespérément.

Ce n'était donc pas la bonne méthode, en voici une autre qui utilise des tableaux VBA :

Sub InsereLigneTableau()
Dim deb As Range, ncol%, derlig&, P As Range, t, tref, rest(), i&, n&, j%
Set deb = [A9:BL9] '1ère ligne du tableau
ncol = deb.Columns.Count 'nombre de colonnes du tableau
derlig = Cells(Rows.Count, deb.Column).End(xlUp).Row
Set P = deb.Resize(derlig - deb.Row + 1)
t = P.FormulaR1C1
tref = P.Columns(ncol).Value 'colonne de référence
ReDim rest(1 To P.Rows.Count + Application.Sum(tref), 1 To ncol)
For i = 1 To P.Rows.Count
  n = n + 1
  For j = 1 To ncol
    rest(n, j) = t(i, j)
  Next
  n = n + tref(i, 1)
Next
deb.Resize(n, ncol) = rest
End Sub

Les valeurs et les formules sont copiées, mais les formats sont ignorés (pas trop gênant je pense).

Sur Win 8 - Excel 2013 la macro s'exécute en 13 secondes.

Bonne nuit.

 

[oxychene]

Re : Création de X lignes par rapport à une cellule

Bonjour à tous, à job75,

super effectivement cela fonctionne, j'ai eu peur pendant ces 20 secondes à voir mon écran bloqué mais c'est le résultat escompté.

Pensez vous que les macros pourrais aussi venir à bout du travail. En reprennent les articles et à les coller dans les cellules nouvellement créées.

A savoir les fournitures et locations en premier puis les opérations (main d'oeuvre) et matériel associé, puis la sous traitance si il en à.

Attention les articles rangés dans les colonnes ne sont pas dans le bon ordres, quelque fois il y à trois matériels enregistré avec seulement une main d'oeuvre!

Leur cellule de destination serait en colonne D, et en AJ pour le matériel sous chaque sous ensembles correspondant avec bien sur une ligne blanche entre chaque sous ensembles complétés.

Pour la suite avec une formule index(equiv()) je saurais me dépatouiller.

Mais en ce moment il me faut renommer les quelques 15000 lignes de matériaux manuellement car ça malheureusement l'informatique ne sais pas faire.

Encore merci pour votre contribution job 75 et bon week end

 

[job75]

Re : Création de X lignes par rapport à une cellule

Bonjour oxychene, le forum,

Avec la méthode par tableaux ce qui me chiffonne c'est que les formats soient ignorés.

Alors on peut combiner les 2 méthodes en supprimant provisoirement les formules de la feuille :

Sub InsereLignes()
Dim duree, deb As Range, ncol%, derlig&, P As Range, rc&, t, tref, rest(), i&, n&, j%
duree = Timer
Set deb = [A9:BL9] '1ère ligne du tableau
ncol = deb.Columns.Count 'nombre de colonnes du tableau
derlig = Cells(Rows.Count, deb.Column).End(xlUp).Row
Set P = deb.Resize(derlig - deb.Row + 1)
rc = P.Rows.Count
t = P.FormulaR1C1
tref = P.Columns(ncol).Value 'colonne de référence
'---tableau des résultats---
ReDim rest(1 To rc + Application.Sum(tref), 1 To ncol)
For i = 1 To rc
  n = n + 1
  For j = 1 To ncol
    rest(n, j) = t(i, j)
  Next
  n = n + tref(i, 1)
Next
Application.EnableEvents = False ' si macros évènementielles
Application.Calculation = xlCalculationManual 'si formules volatiles dans le classeur
'---suppression des formules---
P = P.Value
'---insertion réelle de lignes---
For i = rc To 1 Step -1
  P(i + 1, 1).Resize(tref(i, 1)).EntireRow.Insert
  Application.StatusBar = "Réalisé " & Int(100 * (rc - i + 1) / rc) & " %" _
    & " - Lignes restantes " & i - 1
Next
'---restitution des formules---
deb.Resize(n, ncol) = rest
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
MsgBox "Durée " & Format(Timer - duree, "0.00 \s")
End Sub

La macro s'exécute en 5 minutes 30 secondes.

Le fichier sur Cjoint :

Document Cjoint

Remarques :

1) ce qui plombait la 1ère méthode ce sont les formules (colonnes BH:BL)

2) Application.StatusBar permet de suivre la progression dans la barre d'état.

Edit : si l'on ajoute Application.ScreenUpdating = False l'exécution prend 4 minutes 3 secondes.

Mais la barre d'état se fige à 4 %...

A+

 

[job75]

Re : Création de X lignes par rapport à une cellule

Re,

Pensez vous que les macros pourrais aussi venir à bout du travail. En reprennent les articles et à les coller dans les cellules nouvellement créées.

A savoir les fournitures et locations en premier puis les opérations (main d'oeuvre) et matériel associé, puis la sous traitance si il en à.

Attention les articles rangés dans les colonnes ne sont pas dans le bon ordres, quelque fois il y à trois matériels enregistré avec seulement une main d'oeuvre!

Leur cellule de destination serait en colonne D, et en AJ pour le matériel sous chaque sous ensembles correspondant avec bien sur une ligne blanche entre chaque sous ensembles complétés.

Il suffit de compléter les lignes vides créées dans le tableau VBA rest().

Mais pour comprendre ce que vous voulez il faudrait joindre le fichier en complétant les cellules, par exemple avec les données des 2 premières lignes traitées.

A+