Modification macro

Le 26/07/2016 à 15:03

Bonjour,

J'ai créé une macro il y a quelque temps et j'aimerais l'améliorer mais je coince. Je précise que mes connaissances en macro relèvent bien plus de la débrouillardise et des recherches sur internet qu'autre chose.

Je ne sais pas si ma macro est très académique mais elle fonctionne, le seul bémol c'est qu'il lui faut bien 15 secondes pour s’exécuter, c'est relativement lent.

Voici ma macro:

Sub AjouterNCouND()

ActiveCell.Offset(1, 0).EntireRow.Insert

Rows(ActiveCell.Row).Copy

Rows(ActiveCell.Row + 1).Select

ActiveSheet.Paste

ActiveCell.Offset(-1, 11).Select

Application.CutCopyMode = False

ActiveCell.FormulaR1C1 = "VDM16"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = ""

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "-"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "221213"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = ""

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "-"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "-"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "-"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "-"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "0.02"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = ICI JE VOUDRAIS UNE FORMULE DU TYPE: CELLULE ACTIVE = CELLULE A DROITE DE LA CELLULE ACTIVE DIVISE PAR LA CELLULE A GAUCHE DE LA CELLULE ACTIVE (SACHANT QUE LA CELLULE A DROITE NE SERA COMPLETEE QU'A LA FIN DE LA MACRO)

ActiveCell.Offset(0, 5).Select

ActiveCell.FormulaR1C1 = "-"

ActiveCell.Offset(0, -4).Select

ActiveCell.Offset(1, 0).EntireRow.Insert

Rows(ActiveCell.Row).Copy

Rows(ActiveCell.Row + 1).Select

ActiveSheet.Paste

ActiveCell.Offset(-1, 11).Select

Application.CutCopyMode = False

ActiveCell.FormulaR1C1 = "VDM16"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = ""

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "-"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "221122"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = ""

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "-"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "-"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "-"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "-"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "0.04"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = ICI JE VOUDRAIS UNE FORMULE DU TYPE: CELLULE ACTIVE = CELLULE 1x A DROITE ET 1X EN BAS DE LA CELLULE ACTIVE DIVISE PAR LA CELLULE A GAUCHE DE LA CELLULE ACTIVE

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = ICI JE VOUDRAIS UNE FORMULE DU TYPE: CELLULE ACTIVE = CELLULE 2x A GAUCHE DE LA CELLULE ACTIVE MULTIPLIE PAR LA CELLULE 1X A GAUCHE DE LA CELLULE ACTIVE

ActiveCell.Offset(0, 4).Select

ActiveCell.FormulaR1C1 = "-"

ActiveCell.Offset(0, -4).Select

ActiveCell.Offset(1, 0).EntireRow.Insert

Rows(ActiveCell.Row).Copy

Rows(ActiveCell.Row + 1).Select

ActiveSheet.Paste

ActiveCell.Offset(-1, 11).Select

Application.CutCopyMode = False

ActiveCell.FormulaR1C1 = "VDM16"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = ""

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "-"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "221013"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = ""

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "-"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "-"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "-"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "-"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "0.0075"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = ICI JE VOUDRAIS UNE FORMULE DU TYPE: CELLULE ACTIVE = CELLULE 1x A DROITE ET 2X EN BAS DE LA CELLULE ACTIVE DIVISE PAR LA CELLULE A GAUCHE DE LA CELLULE ACTIVE

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = ICI JE VOUDRAIS UNE FORMULE DU TYPE: CELLULE ACTIVE = CELLULE 2x A GAUCHE DE LA CELLULE ACTIVE MULTIPLIE PAR LA CELLULE 1X A GAUCHE DE LA CELLULE ACTIVE

ActiveCell.Offset(0, 4).Select

ActiveCell.FormulaR1C1 = "-"

ActiveCell.Offset(0, -4).Select

End Sub

Je ne sais pas envoyer le fichier excel car trop volumineux. J'espère que ce que je demande est clair, parceque quand je me relis, je me fais peur.

Si quelqu'un sait m'aider, ce serait top.

Merci à tous!

Le 26/07/2016 à 15:55

Bonjour Strongbow, bonjour le forum

C'est normal, les Select ralentissent considérablement l'exécution d'une macro. Il faut les éviter autant que tu le peux.

mais comme tu prends comme base ActiveCell c'est sûr que c'est pas facile

Ton code est bien trop long pour que je m'y attelle mais je commencerais comme ça :

Dim CEL As Range
Set CEL = ActiveCell

Ensuite j'utiliserais la variable CEL plutôt qu'Activecell.

Pour la suite, un Copier/Coller n'a besoin d'aucun Select. La syntaxe est soit :

Original.Copy Destination qui donne, avec un exemple précis :

Sheets("Feuil1").Range("A1").Copy Sheets("Feuil2").Range("D1")

qui récupère les formats de l'original, soit :

Sheets("Feuil2").Range("D1").Value = Sheets("Feuil1").Range("A1")

qui ne récupère que la valeur...

Bon courage pour revoir ton code sans Select (ou le moins possible) !...

Le 26/07/2016 à 17:32

Merci pour ta réponse ThauThème.

Ok je comprends bien que les Select ralentissent la macro. Mais j'avoue bugger quand tu me dis de les éviter, j'ai essayé d'alléger ma macro comme ceci.

Ma macro sert à copier 3 fois la ligne où je suis positionné. Lorsque je copie la première ligne, je change plusieurs cellules et puis pour les deux autres lignes, il y a 2 celulles qui changent.

Voici ma macro allégée:

Sub AjouterNCouND()

Application.Calculation = xlCalculationManual

Application.ScreenUpdating = False

ActiveCell.Offset(1, 0).EntireRow.Insert

Rows(ActiveCell.Row).Copy

Rows(ActiveCell.Row + 1).Select

ActiveSheet.Paste

ActiveCell.Offset(-1, 11).Select

Application.CutCopyMode = False

ActiveCell.FormulaR1C1 = "VDM16"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = ""

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "-"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "221213"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = ""

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "-"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "-"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "-"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "-"

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "0.02"

ActiveCell.Offset(0, 6).Select

ActiveCell.FormulaR1C1 = "-"

ActiveCell.Offset(1, 0).EntireRow.Insert

Rows(ActiveCell.Row).Copy

Rows(ActiveCell.Row + 1).Select

ActiveSheet.Paste

ActiveCell.Offset(-1, 14).Select

Application.CutCopyMode = False

ActiveCell.FormulaR1C1 = "221122"

ActiveCell.Offset(0, 6).Select

ActiveCell.FormulaR1C1 = "0.04"

ActiveCell.Offset(1, 0).EntireRow.Insert

Rows(ActiveCell.Row).Copy

Rows(ActiveCell.Row + 1).Select

ActiveSheet.Paste

ActiveCell.Offset(-1, 14).Select

Application.CutCopyMode = False

ActiveCell.FormulaR1C1 = "221013"

ActiveCell.Offset(0, 6).Select

ActiveCell.FormulaR1C1 = "0.0075"

ActiveCell.Offset(2, 2).Select

Application.ScreenUpdating = True

Application.Calculation = xlCalculationAutomatic

End Sub

Les macro c'est tellement génial mais ça paraît tellement sorcier. lol

Le 26/07/2016 à 19:42

Re,

Pas sûr que ce soit exactement ça (j'ai eu la flemme de tester car tu n'as pas joint de fichier) mais tu devrais y parvenir avec l'exemple. J'ai gardé ton code en commentaire derrière l'équivalent sans aucun Select :

Sub AjouterNCouND()
Dim C As Range 'déclare la variable C (Cellule)

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Set C = Cells(ActiveCell.Row, 1) 'définit la cellule C (cellule ligne : ligne de la cellule active, colonne : 1)
Rows(C.Row + 1).Insert 'ActiveCell.Offset(1, 0).EntireRow.Insert 'insère une lige
Rows(C.Row + 1).Insert 'ActiveCell.Offset(1, 0).EntireRow.Insert 'insère une lige
Rows(C.Row + 1).Insert 'ActiveCell.Offset(1, 0).EntireRow.Insert 'insère une lige

Rows(C.Row).Copy C.Offset(1, 0) 'Rows(ActiveCell.Row).Copy : Rows(ActiveCell.Row + 1).Select : ActiveSheet.Paste
C.Offset(1, 12).Value = "VDM16" 'ActiveCell.Offset(-1, 11).Select : Application.CutCopyMode = False : ActiveCell.FormulaR1C1 = "VDM16"
C.Offset(1, 13).Value = "" 'ActiveCell.Offset(0, 1).Select : ActiveCell.FormulaR1C1 = ""
C.Offset(1, 14).Value = "" 'ActiveCell.Offset(0, 1).Select : ActiveCell.FormulaR1C1 = "-"
C.Offset(1, 15).Value = "221213" 'ActiveCell.Offset(0, 1).Select : ActiveCell.FormulaR1C1 = "221213"
C.Offset(1, 16).Value = "" 'ActiveCell.Offset(0, 1).Select : ActiveCell.FormulaR1C1 = ""
C.Offset(1, 17).Value = "-" 'ActiveCell.Offset(0, 1).Select : ActiveCell.FormulaR1C1 = "-"
C.Offset(1, 18).Value = "-" 'ActiveCell.Offset(0, 1).Select: ActiveCell.FormulaR1C1 = "-"
C.Offset(1, 19).Value = "-" 'ActiveCell.Offset(0, 1).Select : ActiveCell.FormulaR1C1 = "-"
C.Offset(1, 20).Value = "-" 'ActiveCell.Offset(0, 1).Select: ActiveCell.FormulaR1C1 = "-"
C.Offset(1, 21).Value = "0.02" 'ActiveCell.Offset(0, 1).Select : ActiveCell.FormulaR1C1 = "0.02"
C.Offset(1, 27).Value = "-" 'ActiveCell.Offset(0, 6).Select : ActiveCell.FormulaR1C1 = "-"

Rows(C.Row).Copy C.Offset(2, 0)
C.Offset(2, 15).Value = "221122" 'ActiveCell.Offset(-1, 14).Select : Application.CutCopyMode = False : ActiveCell.FormulaR1C1 = "221122"
C.Offset(2, 21).Value = "0.4" 'ActiveCell.Offset(0, 6).Select : ActiveCell.FormulaR1C1 = "0.04"

Rows(C.Row).Copy C.Offset(3, 0)
C.Offset(3, 15).Value = "221013" 'ActiveCell.Offset(-1, 14).Select : Application.CutCopyMode = False : ActiveCell.FormulaR1C1 = "221013"
C.Offset(3, 21).Value = "0.0075" 'ActiveCell.Offset(0, 6).Select : ActiveCell.FormulaR1C1 = "0.0075"

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Rechercher des sujets similaires à "modification macro"