Itération dans des macros [Résolu]

Signaler
Messages postés
13123
Date d'inscription
dimanche 19 janvier 2014
Statut
Membre
Dernière intervention
12 mai 2021
-
Messages postés
8536
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
8 mai 2021
-
Bonjour,

Je recherche la syntaxe qui me permettrai de simplifier le code suivant :

Sub itération()
'
' itération Macro
'
    Range("A8").Select
    ActiveCell.FormulaR1C1 = "I-001"
    Range("I8").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Range("I10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Range("A8").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "I-002"
    Range("I8").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Range("I11").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Range("A8").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "I-003"
    Range("I8").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Range("I12").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
End Sub

L'opération est, comme vous le constater, toujours la même.

Je recherche la syntaxe qui me permettrait d'utiliser la macro un nombre n fois (correspondant à un nombre de ligne déterminé par la case K1 avec une formule du type nb.val() ).

Dans le code, les seules différences sont :
- ActiveCell.FormulaR1C1 = "I-001" qui doit atteindre "I-n". Si les deux zéros posent problèmes, il est possible de les supprimer ;
- En parallèle que le dernier range("I10").Select s'incrémente de 1 à chaque tour commençant à la ligne "I10" jusqu'à atteindre la ligne "I(10+n-1)".

Je vous remercie d'avance pour l'aide que vous pourrez m'apporter.

CB
A voir également:

3 réponses

Messages postés
14788
Date d'inscription
vendredi 14 mars 2003
Statut
Modérateur
Dernière intervention
1 mai 2021
155
Déjà, première remarque :
Evite les .Select, ça ralenti le code et c'est quasiment tout le temps évitable.

Range("A8").Select
ActiveCell.FormulaR1C1 = "I-001"

Devien :
Range("A8").FormulaR1C1 = "I-001"

ou
Cells(8,1).FormulaR1C1 = "I-001"
(Paramètres peut être inversé (1,8), je n'ai pas la doc à dispo)

Par contre, je ne connais pas la forme optimisée de :
Range(Selection, Selection.End(xlToRight)).Select

Autrement que :
Range(Range("I8"), Range("I8").End(xlToRight)).Select

Messages postés
8536
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
8 mai 2021
21
Bonjour,

Par exemple :
Sub itération()
Dim r As Range
Dim i As Byte
  For i = 1 To 3
    Range("A8").Formula = "I-00" & i
    Set r = Range("I8")
    Set r = Range(r, r.End(xlToRight))
    Range("I1" & i - 1).Resize(1, r.Columns.Count).Value = r.Value
  Next i
End Sub


Mais, attention à l'emploi de End(xlToRight) : c'est pas l'idéal si la ligne risque d'être vide.

PS: Est-il nécessaire d'écrire la formule en A8 ?
Cordialement
Patrice
Messages postés
13123
Date d'inscription
dimanche 19 janvier 2014
Statut
Membre
Dernière intervention
12 mai 2021

Bonjour,

Dans l'absolu non, mais il est cependant nécessaire que la case modifiée (A8) soit sur la même ligne que les valeurs copiés (I8 et suivantes).

Vous aviez une idée en tête ?

CB
Messages postés
8536
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
8 mai 2021
21 >
Messages postés
13123
Date d'inscription
dimanche 19 janvier 2014
Statut
Membre
Dernière intervention
12 mai 2021

Bonjour,

« Vous aviez une idée en tête ? », Si la valeur des cellules I8 et suivantes ne dépendent pas de A8, cette dernière pourrait être obtenue par une simple formule.

J'ai répondu un peu vite, sans voir que le nombre d'itérations est en K1 !

Voici un mix entre mon code précédent et l'excellent code de ccm81, pour éviter l'emploi de Copy puis PasteSpecial. Ces instructions utilisent le Presse-papier et donc sont beaucoup plus lentes que la copie directe des valeurs dans Excel.
Sub itération()
Dim r As Range, i As Long
With ActiveSheet
For i = 1 To .Range("K1").Value
.Range("A8").Formula = "I-" & Format(i, "000")
Set r = .Cells(8, Columns.Count).End(xlToLeft)
Set r = .Range("I8", r)
.Range("I" & 9 + i).Resize(1, r.Columns.Count).Value = r.Value
Next i
End With
End Sub
Messages postés
13123
Date d'inscription
dimanche 19 janvier 2014
Statut
Membre
Dernière intervention
12 mai 2021

Bonjour merci du retour et des conseils,

Pour info ccm81 m'a transmis les lignes suivantes qui sont fonctionnent sur ma page :

Sub OK()
Dim k As Long, adfin As String, n As Long
With ActiveSheet
  n = .Range("K1").Value
  For k = 1 To n
    .Range("A8").Value = "I-" & Format(k, "000")
    adfin = .Cells(8, Columns.Count).End(xlToLeft).Address
    .Range("I8:" & adfin).Copy
    .Range("I" & 9 + k).PasteSpecial Paste:=xlPasteValues
  Next k
End With
End Sub


CB