Macro à répeter 360 fois contenant une macro

Version imprimable

Bonjour,

je suis débutant en macro et j'aimerai répéter une opération fastidieuse 360 fois dans ma feuille excel.

Voici les actions qui doivent être faites :

Sélectionner une cellule faisant partie d'une liste de 1 à 360
la copier (par exemple la 1ere cellule notée 1)
aller coller la valeur dans une "cellule fixe"
lancer une macro nommée "lissage"
sélectionner une "cellule fixe" dans laquelle apparaitra le résultat
copier le résultat
coller ce résultat dans une cellule

et recommencer cela 359 autres fois.

au final j'aurais donc un petit tableau à deux colonnes, la première numérotée de 1 à 360 et juste à côté tous les résultats correspondants...

maintenant je me demande si j'utilise la bonne stratégie en allant copier les chiffres de 1 à 360 tout ça dans le seul but de faire les 360 calculs, ne serait il pas plus simple de trouver une commande qui permettrait de faire les calculs de 1 à 360 sans cette étape ? car pour mois ce qui compte c'est que la case D4 voit défiler les chiffres de 1 à 360.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 Sub Macro6() ' ' Macro6 Macro ' Range("N17").Select Selection.Copy Range("D4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("D12").Select Application.CutCopyMode = False Selection.Copy Range("O17").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("N18").Select Application.CutCopyMode = False Selection.Copy Range("D4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("D12").Select Application.CutCopyMode = False Selection.Copy Range("O18").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Selection.Copy Range("D4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.Run ("Lissage") Range("D12").Select Application.CutCopyMode = False Selection.Copy Range("o17").Activate While ActiveCell <> "" ActiveCell.Offset(1, 0).Activate Wend Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("o17").Activate While ActiveCell <> "" ActiveCell.Offset(1, 0).Activate Wend Selection.Offset(0, -1).Select etc End Sub
par avance merci à ceux qui pourront m'aider

heu

bonjour

il faut savoir que plus tu utilise les sélect plus se sera long

en vba il y a beaucoup plus simple
voila pour les deux premières a copier
Code:

1 2 3 4 5 6 7 Sub copie() [d4] = [n17].Value Étant donner que l'on copie la "value " tu aura le résultat et pas la formule c'est ce que tu voulais je suppose [o17] = [d12].Value End Sub
au plaisir

16/09/2012, 12h38
spadassi
Bonjour Patrick

je te remercie pour ta réponse,

étant donné que j'ai besoin qu'une autre macro soit exécutée avant d'obtenir le résultat je peux le faire ainsi :
Code:

1 2 3 4 5 Sub copie() [d4] = [n17].Value Application.Run ("Lissage") [o17] = [d12].Value End Sub
c'est cette macro qui me permet d'obtenir le résultat en d12 qui sera donc copié en o17, par contre, comment passer à la formule suivante qui sera :
Code:

1 2 3 4 5 Sub copie() [d4] = [n18].Value Application.Run ("Lissage") [o18] = [d12].Value End Sub
et cela jusqu'à
Code:

1 2 3 4 5 Sub copie() [d4] = [n376].Value Application.Run ("Lissage") [o376] = [d12].Value End Sub
par avance merci
16/09/2012, 14h04
Qwazerty

Salut

Tu devrais nous montrer ta macro Lissage, avec quelques adaptations, il ne devrait plus être nécessaire de copier les valeurs et de lancer à chaque fois la macro.

++
Qwaz
16/09/2012, 14h12
spadassi
Bonjour,

pas de problème, voici ma macro lissage
Code:

1 2 3 4 5 6 Sub lissage() 'ActiveSheet.Unprotect "ecomike" Range("L5").GoalSeek Goal:=0, ChangingCell:=Range("J4") 'ActiveSheet.Protect "ecomike", True, True, True End Sub
je pense que cette macro est inévitable car elle permet de déclencher un ensemble de calculs entre d autres cellules dont le résultat final qui m 'interesse se retrouve en D12

merci

Salut
Peux tu mettre un fichier pour connaitre l'organisation exacte des données.

[Edit]
En attendant voila peut-être une solution avec les données que tu as données dans tes différents post.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub Trouv()
Dim TheCell As Range
 
'On travail sur la feuille nommé Feuil1, attention ceci est son CodeName (Nom dans VBA), pas le nom écrit sur l'onglet en bas de la feuille
With Feuil1
    'On boucle de la cellule N17 à N376
    For Each TheCell In .Range("N17:N376")
        'On place la valeur variable
        .[D4] = TheCell
        'On verifie qu'une valeur a bien été trouvée
        If .[L5].GoalSeek(0, .[J4]) Then
            'Valeur trouvé
            TheCell.Offset(0, 1) = .[D12]
        Else
            'Aucune valeur ne correspond
            TheCell.Offset(0, 1) = "Impossible"
        End If
    Next
End With
 
 
End Sub

[/Edit]
++
Qwaz

16/09/2012, 15h39
spadassi

1 pièce(s) jointe(s)

voici le fichier

bonjour,

merci pour ta réponse, par contre, c'est vrai que ce sera plus simple avec le fichier,

voici le scénario que j'aimerai :

copier le chiffre de n17 dans d4
lancer la macro : lissage
copier le résultat de d12 dans o17

et recommencer jusqu'à "o376"

l'idéal, mais la j'en demande peut être un peu beaucoup 8O, serait que le tableau arrête de se compléter si la valeur contenue dans la colonne n17 à n376 serait supérieure ou égale à la cellule F4

Salut

As tu recherché sur Excel, il existe des fonctions financières, je ne suis pas très alèse avec ce qui touche au calculs financiers, mais je pense que tu y trouverais ton bonheur sans avoir à passer par des macro VBa

Essai en ajoutant en bouton et en plaçant se code dedans

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Sub LissageTotal_Clic()
 
Dim TheCell As Range
 
'On bloque le refraichissement de l'ecran (gain en rapidité)
Application.ScreenUpdating = False
 
'On travail sur la feuille nommé Feuil2, attention ceci est son CodeName (Nom dans VBA), pas le nom écrit sur l'onglet en bas de la feuille
With Feuil2
 
    'On supprime d'éventuels anciens résultats
    .[O17:O376].ClearContents
 
    'On boucle de la cellule N17 à N376
    For Each TheCell In .Range("N17:N376")
        'On verifie si TheCell est inférieur à F4, sinon on arrête
        If TheCell >= .[F4] Then Exit For
 
        'On place la valeur variable
        .[D4] = TheCell
        'On verifie qu'une valeur a bien été trouvée
        If .[L5].GoalSeek(0, .[J4]) Then
            'Valeur trouvé
            TheCell.Offset(0, 1) = .[D12]
        Else
            'Aucune valeur ne correspond
            TheCell.Offset(0, 1) = "Impossible"
        End If
    Next
End With
 
Application.ScreenUpdating = True
End Sub

++
Qwaz

16/09/2012, 17h52
spadassi

je suis bluffé !!!
ça fonctionne parfaitement !!!!!
merci pour tout !:D