|
 Posté le 24/06/2013 @ 14:54 |
Petit astucien
| bonjour,
je souhaite utiliser cette macro pour générer un nouveau tableau. En voulant l'éxécuter, excel me renvoie "erreur de compilation : procédure trop grande".
Je sais qu'il y a moyen de diminuer considérablement la longueur de ma procédure car j'ai utilisé l'enregistreur de macro et non fait de la programmation. Est ce quelqu'un pourrait déjà un peu simplifier ce code en VBA, pour que la procédure soit moins grande ?
merci d'avance
ActiveCell.FormulaR1C1 = "Réseaux" Range("H10").Select ActiveCell.FormulaR1C1 = "N° Lot" Range("I10").Select ActiveCell.FormulaR1C1 = "janvier" Range("I10").Select Selection.AutoFill Destination:=Range("I10:T10"), Type:=xlFillDefault Range("I10:T10").Select ActiveWindow.ScrollColumn = 6 Range("U10").Select ActiveCell.FormulaR1C1 = "TOTAL HT" Range("G11").Select ActiveCell.FormulaR1C1 = "RCS" Range("G16").Select ActiveCell.FormulaR1C1 = "RCO" Range("G21").Select ActiveCell.FormulaR1C1 = "RRP" Range("G26").Select ActiveCell.FormulaR1C1 = "RCA" Range("H11").Select ActiveCell.FormulaR1C1 = "1" Range("H12").Select ActiveCell.FormulaR1C1 = "2" Range("H13").Select ActiveCell.FormulaR1C1 = "3" Range("H14").Select ActiveCell.FormulaR1C1 = "4" Range("H15").Select ActiveCell.FormulaR1C1 = "Sous Total" Range("H11:H15").Select Selection.Copy Range("H16").Select ActiveSheet.Paste Range("H21").Select ActiveSheet.Paste Range("H26").Select ActiveSheet.Paste Application.CutCopyMode = False Range("G10:H30").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Range("I10:U10").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Range("G11:G15").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.Merge Range("G16:G20").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.Merge Range("G21:G25").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.Merge Range("G26:G30").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.Merge Range("G11:G30").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext End With Range("I11").Select ActiveWindow.ScrollColumn = 5 ActiveWindow.ScrollColumn = 4 ActiveWindow.ScrollColumn = 3 ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 1 Range("B7").Select ActiveCell.FormulaR1C1 = "1" Range("E35").Select Selection.Copy Range("I11").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("I16").Select ActiveWindow.SmallScroll Down:=9 Range("E53").Select Application.CutCopyMode = False Selection.Copy Range("I16").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWindow.SmallScroll Down:=9 Range("E71").Select Application.CutCopyMode = False Selection.Copy Range("I21").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("I26").Select ActiveWindow.SmallScroll Down:=15 Range("E89").Select Application.CutCopyMode = False Selection.Copy ActiveWindow.SmallScroll Down:=-15 Range("I26").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWindow.SmallScroll Down:=-18 Range("B7").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "2" Range("E35").Select Selection.Copy Range("I12").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("I17").Select ActiveWindow.SmallScroll Down:=12 Range("E53").Select Application.CutCopyMode = False Selection.Copy ActiveWindow.SmallScroll Down:=-3 Range("I17").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWindow.SmallScroll Down:=9 Range("E71").Select Application.CutCopyMode = False Selection.Copy Range("I22").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("I27").Select ActiveWindow.SmallScroll Down:=12 Range("E89").Select Application.CutCopyMode = False Selection.Copy ActiveWindow.SmallScroll Down:=-9 Range("I27").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWindow.SmallScroll Down:=-21 Range("B7").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "3" Range("E35").Select Selection.Copy Range("I13").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("I18").Select ActiveWindow.SmallScroll Down:=15 Range("E53").Select Application.CutCopyMode = False Selection.Copy Range("I23").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("I28").Select ActiveWindow.SmallScroll Down:=-6 Range("I23").Select Application.CutCopyMode = False Selection.Cut Range("I18").Select ActiveSheet.Paste Range("I23").Select ActiveWindow.SmallScroll Down:=12 Range("E71").Select Selection.Copy ActiveWindow.SmallScroll Down:=-9 Range("I23").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("I28").Select ActiveWindow.SmallScroll Down:=27 Range("E89").Select Application.CutCopyMode = False Selection.Copy ActiveWindow.SmallScroll Down:=-21 Range("I28").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWindow.SmallScroll Down:=-12 Range("B7").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "4" Range("E35").Select Selection.Copy Range("I14").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("I19").Select ActiveWindow.SmallScroll Down:=9 Range("E53").Select Application.CutCopyMode = False Selection.Copy Range("I19").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("I24").Select ActiveWindow.SmallScroll Down:=6 Range("E71").Select Application.CutCopyMode = False Selection.Copy Range("I24").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("I29").Select ActiveWindow.SmallScroll Down:=9 Range("E89").Select Application.CutCopyMode = False Selection.Copy ActiveWindow.SmallScroll Down:=-6 Range("I29").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWindow.SmallScroll Down:=-15 Range("C18").Select ActiveWindow.SmallScroll Down:=-6 Range("B7").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "1" Range("E35").Select Selection.Copy Range("J11").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("E53").Select Application.CutCopyMode = False Selection.Copy Range("J16").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWindow.SmallScroll Down:=12 Range("E71").Select Application.CutCopyMode = False Selection.Copy ActiveWindow.SmallScroll Down:=-6 Range("J21").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("J26").Select ActiveWindow.SmallScroll Down:=21 Range("E89").Select Application.CutCopyMode = False Selection.Copy ActiveWindow.SmallScroll Down:=-15 Range("J26").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveWindow.SmallScroll Down:=-15 Range("B7").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "2" Range("E35").Select Selection.Copy Range("J12").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("J17").Select ActiveWindow.SmallScroll Down:=12 Range("E53").Select Application.CutCopyMode = False Selection.Copy Range("J17").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("E71").Select Application.CutCopyMode = False Selection.Copy Range("J22").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("J27").Select ActiveWindow.SmallScroll Down:=24 Range("E89").Select Application.CutCopyMode = False Selection.Copy ActiveWindow.SmallScroll Down:=-15 Range("J27").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End Sub
|
|
|
|
|
|
Posté le 24/06/2013 à 15:27 |
Astucien | Bonjour,
Les 3/4 à supprimer environ, et il manque des données par ailleurs.
Ce serait plus simple d'avoir le modèle de tableau à reproduire .

D'autre part, aurais-tu abandonné ton précédent sujet ? |
|
Posté le 24/06/2013 à 15:35 |
Petit astucien
| oui je ne suis pas étonné que ce soit possible d'en enlever 3/4.
Le reste de données présente à peu près la même configuration et donc je me débrouillerai après, si la procédure n'est plus trop longue.
Pour le sujet précédent, cette macro servirait d'alternative.
merci |
|
Posté le 24/06/2013 à 16:06 |
Petit astucien
| est-il possible d'alléger/d'optimiser cette formulation lourde svp ?
il n'y a pas forcément besoin du fichier.
merci d'avance |
|
Posté le 24/06/2013 à 16:07 |
Astucien | Je crois qu'on ne se comprend pas ! Déjà ta macro ne commençant pas par Sub, on ignore s'il y a du code qui précède. On ne peut que supposer que la première affectation qui apparaît est en G10 car la cellule n'est pas nommée. On suit ensuite la série d'affectations (à élaguer du code inutile). On traverse une zone de mise en forme centrée un peu cafouilleuse à vérifier, puis on tombe sur de la copie de cellule dont on ne connaît pas le contenu. A E53 j'ai considéré inutile de lire plus avant. L'objectif à réaliser doit être clair et précis pour concevoir une macro rationnelle.
Et je ne vois pas de lien entre ce projet et ton sujet précédent.

|
|
Posté le 24/06/2013 à 16:23 |
Petit astucien
| merci de m'avoir répondu.
la macro commence bien par Sub, c'est juste que j'ai omis de copier cette ligne. Pour la suite, l'objectif est toujours le même au final, à savoir la création d'un tableau récapitulatif annuel à partir d'un synoptique.
Ayant déjà fait un assez lourd travail sur le bon de commande (tableau de gauche, cf discussion création d'un tableau récapitulafif), je souhaite générer ce nouveau tableau annuel à partir du bon de commande automatisé avec des formules.
Est-ce plus clair ?
p.s : c'est le même fichier que celui que j'ai joint dans le sujet précédent sauf que j'utilise une méthode alternative si possible.
merci bien. |
|
Posté le 25/06/2013 à 09:40 |
Petit astucien
| si quelqu'un peut simplifier cette macro, ça m'aiderait énormément.
merci d'avance |
|
Posté le 25/06/2013 à 12:52 |
| bonjour,
un début :
Sub xxx() [A1] = "Réseaux" [H10] = "N° Lot" [I10] = "janvier" [I10].AutoFill Destination:=Range("I10:T10"), Type:=xlFillDefault Range("I10:T10").Select 'ActiveWindow.ScrollColumn = 6 A SUPPRIMER [U10] = "TOTAL HT" [G11] = "RCS" [G16] = "RCO" [G21] = "RRP" [G26] = "RCA" [H11] = "1" [H12] = "2" [H13] = "3" [H14] = "4" [H15] = "Sous Total" [H11:H15].Copy [H16,H21,H26].Select ActiveSheet.Paste
[G10:H30,I10:U10,G11:G30].Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom End With
que selectionne tu ?
Range("I11").Select ActiveWindow.ScrollColumn = 5 A SUPPRIMER ActiveWindow.ScrollColumn = 4 A SUPPRIMER ActiveWindow.ScrollColumn = 3 A SUPPRIMER ActiveWindow.ScrollColumn = 2 A SUPPRIMER ActiveWindow.ScrollColumn = 1 A SUPPRIMER Range("B7").Select ActiveCell.FormulaR1C1 = "1" Range("E35").Select
ayant deja fait cela tu y verras plus clair
|
|
Posté le 27/06/2013 à 09:58 |
Petit astucien
| bonjour,
merci pour ce qui a été fait. Je souhaite en fin de compte copier les totaux E35, E53 et E89 dans un tableau (G10:U30) en fonction des libellés N°lot et mois que je change respectivement en cellule B7 et C18
J'ai remodifié ma macro qui donne ça maintenant mais elle est toujours trop longue (cf doc joint).
http://cjoint.com/?CFBj6bUjOGu |
|
|
|
|
|
Posté le 27/06/2013 à 12:24 |
| re,
il n'y a pas de code dans ton fichier;
peux tu expliquer ceci :
Range("I11").Select 'ActiveWindow.ScrollColumn = 5 'ActiveWindow.ScrollColumn = 4 'ActiveWindow.ScrollColumn = 3 'ActiveWindow.ScrollColumn = 2 'ActiveWindow.ScrollColumn = 1 Range("B7").Select ActiveCell.FormulaR1C1 = "1" Range("E35").Select Selection.Copy
tu selectionne I11 ou B7 ou les deux ????? |
|
Posté le 27/06/2013 à 13:56 |
Petit astucien
| la cellule I11 est celle qui reçoit la valeur.
la cellule B7 vaut 1 (n°lot=1) dans ce cas présent.
dans la liste de choix de la cellule C18, le mois choisi doit être "janvier".
La macro fera donc ici un copier-coller spécial de la cellule I11 en respectant les bonnes conditions des cellules B7 et C18.
Est-ce clair ?
merci |
|
Posté le 27/06/2013 à 14:38 |
| ton code un peu epure :
Sub xxx() [ActiveCell] = "Réseaux" 'Précise la cellule c'est préférable [H10] = "N° Lot" [I10] = "janvier" [I10].AutoFill Destination:=Range("I10:T10"), Type:=xlFillDefault Range("I10:T10").Select [U10] = "TOTAL HT" [G11] = "RCS" [G16] = "RCO" [G21] = "RRP" [G26] = "RCA" [H11] = "1" [H12] = "2" [H13] = "3" [H14] = "4" [H15] = "Sous Total" [H11:H15].Copy [H16,H21,H26].Select ActiveSheet.Paste Application.CutCopyMode = False Range("G10:H30,I10:U10,G11:G15,G16:G20,G21:G25, ,G11:G30").Select Call Forma Range("I10:U10").Select Call Forma Range("G11:G15").Select Call Forma Selection.Merge Range("G16:G20").Select Call Forma Selection.Merge Range("G21:G25").Select Call Forma Selection.Merge Range("G26:G30").Select Selection.Merge Range("G11:G30").Select Call Forma [I11].Select [B7] = "1" [E35].Copy Range("I11").Select Call Forma Range("I16").Select Range("E53").Select Application.CutCopyMode = False Selection.Copy Range("I16").Select Call Forma Range("E71").Select Application.CutCopyMode = False Selection.Copy Range("I21").Select Call Forma Range("I26").Select Range("E89").Select Application.CutCopyMode = False Selection.Copy Range("I26").Select Call Forma Range("B7").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "2" Range("E35").Select Selection.Copy Range("I12").Select Call Forma Range("I17").Select Range("E53").Select Application.CutCopyMode = False Selection.Copy Range("I17").Select Call Forma Range("E71").Select Application.CutCopyMode = False Selection.Copy Range("I22").Select Call Forma Range("I27").Select Range("E89").Select Application.CutCopyMode = False Selection.Copy Range("I27").Select Call Forma Range("B7").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "3" Range("E35").Select Selection.Copy Range("I13").Select Range("I18").Select Range("E53").Select Application.CutCopyMode = False Selection.Copy Range("I23").Select Call Forma Range("I28").Select Range("I23").Select Application.CutCopyMode = False Selection.Cut Range("I18").Select ActiveSheet.Paste Range("I23").Select Range("E71").Select Selection.Copy Range("I23").Select Call Forma Range("I28").Select Range("E89").Select Application.CutCopyMode = False Selection.Copy Range("I28").Select Call Forma Range("B7").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "4" Range("E35").Select Selection.Copy Range("I14").Select Call Forma Range("I19").Select Range("E53").Select Application.CutCopyMode = False Selection.Copy Range("I19").Select Call Forma Range("I24").Select Range("E71").Select Application.CutCopyMode = False Selection.Copy Range("I24").Select Call Forma Range("I29").Select Range("E89").Select Application.CutCopyMode = False Selection.Copy Range("I29").Select Call Forma Range("C18").Select Range("B7").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "1" Range("E35").Select Selection.Copy Range("J11").Select Call Forma Range("E53").Select Application.CutCopyMode = False Selection.Copy Range("J16").Select Call Forma Range("E71").Select Application.CutCopyMode = False Selection.Copy Range("J21").Select Call Forma Range("J26").Select Range("E89").Select Application.CutCopyMode = False Selection.Copy Range("J26").Select Range("B7").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "2" Range("E35").Select Selection.Copy Range("J12").Select Call Forma Range("J17").Select Range("E53").Select Application.CutCopyMode = False Selection.Copy Range("J17").Select Call Forma Range("E71").Select Application.CutCopyMode = False Selection.Copy Range("J22").Select Range("J27").Select Range("E89").Select Application.CutCopyMode = False Selection.Copy Range("J27").Select Call Forma End Sub
Sub Collage() Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End Sub
Sub Forma() Range("I10:U10").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom End With End Sub
a toi de continuer, je ne suis pas un specialiste des codes mais on peut encore tailler dans le vif, le debut devrait t'aider |
|
Posté le 30/06/2013 à 15:24 |
Nouvel astucien
| C'est difficile de nettoyer la macro sans avoir une petite idée de ce qu'elle est sensé faire, pourrais tu donner plus de précisions sur son rôle ? |
|