Synthétiser une Macro

Version imprimable

Bonjour à tous,
Dans un premier temps je souhaite la bonne année à tout le monde :)
Je suis nouveau sur developpez.com et j'aurais besoin d'aide pour synthétiser une macro excel.
En effet, la macro que j'ai créée est trop lourde et donc longue à s’exécuter, elle me permet de récupérer les cours des devises (bourse) sur le marché du Forex en temps réel (avec un lien DDE) afin que je puisse les exploiter.
Merci d'avance à tous !

Voici la macro ...

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
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
Sub ReleveCotations()
 
 
Rows("2:2").Select
    Selection.Copy
    Range("A3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Application.Run ("MyMacro")
 
End Sub
 
Sub MyMacro()
 
 
 
Application.OnTime Now + TimeValue("00:00:01"), "MyMacro"
 
 
 
If Sheets("GENERAL").Range("A" & Range("A65536").End(xlUp).Row).Value <> Sheets("GENERAL").Range("A" & Range("A1").Row + 1).Value Then
 Range("A" & Range("A65536").End(xlUp).Row + 1).Value = CDbl(Cells(2, 1))
End If
 
If Sheets("GENERAL").Range("B" & Range("B65536").End(xlUp).Row).Value <> Sheets("GENERAL").Range("B" & Range("B1").Row + 1).Value Then
 Range("B" & Range("B65536").End(xlUp).Row + 1).Value = CDbl(Cells(2, 2))
End If
 
If Sheets("GENERAL").Range("C" & Range("C65536").End(xlUp).Row).Value <> Sheets("GENERAL").Range("C" & Range("C1").Row + 1).Value Then
 Range("C" & Range("C65536").End(xlUp).Row + 1).Value = CDbl(Cells(2, 3))
End If
 
If Sheets("GENERAL").Range("D" & Range("D65536").End(xlUp).Row).Value <> Sheets("GENERAL").Range("D" & Range("D1").Row + 1).Value Then
 Range("D" & Range("D65536").End(xlUp).Row + 1).Value = CDbl(Cells(2, 4))
End If
 
 If Sheets("GENERAL").Range("E" & Range("E65536").End(xlUp).Row).Value <> Sheets("GENERAL").Range("E" & Range("E1").Row + 1).Value Then
 Range("E" & Range("E65536").End(xlUp).Row + 1).Value = CDbl(Cells(2, 5))
End If
 
 If Sheets("GENERAL").Range("F" & Range("F65536").End(xlUp).Row).Value <> Sheets("GENERAL").Range("F" & Range("F1").Row + 1).Value Then
 Range("F" & Range("F65536").End(xlUp).Row + 1).Value = CDbl(Cells(2, 6))
End If
 
 If Sheets("GENERAL").Range("G" & Range("G65536").End(xlUp).Row).Value <> Sheets("GENERAL").Range("G" & Range("G1").Row + 1).Value Then
 Range("G" & Range("G65536").End(xlUp).Row + 1).Value = CDbl(Cells(2, 7))
End If
 
 If Sheets("GENERAL").Range("H" & Range("H65536").End(xlUp).Row).Value <> Sheets("GENERAL").Range("H" & Range("H1").Row + 1).Value Then
 Range("H" & Range("H65536").End(xlUp).Row + 1).Value = CDbl(Cells(2, 8))
End If
 
If Sheets("GENERAL").Range("I" & Range("I65536").End(xlUp).Row).Value <> Sheets("GENERAL").Range("I" & Range("I1").Row + 1).Value Then
 Range("I" & Range("I65536").End(xlUp).Row + 1).Value = CDbl(Cells(2, 9))
End If
 
If Sheets("GENERAL").Range("J" & Range("J65536").End(xlUp).Row).Value <> Sheets("GENERAL").Range("J" & Range("J1").Row + 1).Value Then
 Range("J" & Range("J65536").End(xlUp).Row + 1).Value = CDbl(Cells(2, 10))
End If
 
 If Sheets("GENERAL").Range("K" & Range("K65536").End(xlUp).Row).Value <> Sheets("GENERAL").Range("K" & Range("K1").Row + 1).Value Then
 Range("K" & Range("K65536").End(xlUp).Row + 1).Value = CDbl(Cells(2, 11))
End If
 
 If Sheets("GENERAL").Range("L" & Range("L65536").End(xlUp).Row).Value <> Sheets("GENERAL").Range("L" & Range("L1").Row + 1).Value Then
 Range("L" & Range("L65536").End(xlUp).Row + 1).Value = CDbl(Cells(2, 12))
End If
 
 If Sheets("GENERAL").Range("M" & Range("M65536").End(xlUp).Row).Value <> Sheets("GENERAL").Range("M" & Range("M1").Row + 1).Value Then
 Range("M" & Range("M65536").End(xlUp).Row + 1).Value = CDbl(Cells(2, 13))
End If
 
If Sheets("GENERAL").Range("N" & Range("N65536").End(xlUp).Row).Value <> Sheets("GENERAL").Range("N" & Range("N1").Row + 1).Value Then
 Range("N" & Range("N65536").End(xlUp).Row + 1).Value = CDbl(Cells(2, 14))
End If
 
 If Sheets("GENERAL").Range("O" & Range("O65536").End(xlUp).Row).Value <> Sheets("GENERAL").Range("O" & Range("O1").Row + 1).Value Then
 Range("O" & Range("O65536").End(xlUp).Row + 1).Value = CDbl(Cells(2, 15))
End If
 
If Sheets("GENERAL").Range("P" & Range("P65536").End(xlUp).Row).Value <> Sheets("GENERAL").Range("P" & Range("P1").Row + 1).Value Then
 Range("P" & Range("P65536").End(xlUp).Row + 1).Value = CDbl(Cells(2, 16))
End If
 
 If Sheets("GENERAL").Range("Q" & Range("Q65536").End(xlUp).Row).Value <> Sheets("GENERAL").Range("Q" & Range("Q1").Row + 1).Value Then
 Range("Q" & Range("Q65536").End(xlUp).Row + 1).Value = CDbl(Cells(2, 17))
End If
 
 If Sheets("GENERAL").Range("R" & Range("R65536").End(xlUp).Row).Value <> Sheets("GENERAL").Range("R" & Range("R1").Row + 1).Value Then
 Range("R" & Range("R65536").End(xlUp).Row + 1).Value = CDbl(Cells(2, 18))
End If
 
If Sheets("GENERAL").Range("S" & Range("S65536").End(xlUp).Row).Value <> Sheets("GENERAL").Range("S" & Range("S1").Row + 1).Value Then
 Range("S" & Range("S65536").End(xlUp).Row + 1).Value = CDbl(Cells(2, 19))
End If
 
If Sheets("GENERAL").Range("T" & Range("T65536").End(xlUp).Row).Value <> Sheets("GENERAL").Range("T" & Range("T1").Row + 1).Value Then
 Range("T" & Range("T65536").End(xlUp).Row + 1).Value = CDbl(Cells(2, 20))
End If
 
If Sheets("GENERAL").Range("U" & Range("U65536").End(xlUp).Row).Value <> Sheets("GENERAL").Range("U" & Range("U1").Row + 1).Value Then
 Range("U" & Range("U65536").End(xlUp).Row + 1).Value = CDbl(Cells(2, 21))
End If
 
If Sheets("GENERAL").Range("V" & Range("V65536").End(xlUp).Row).Value <> Sheets("GENERAL").Range("V" & Range("V1").Row + 1).Value Then
 Range("V" & Range("V65536").End(xlUp).Row + 1).Value = CDbl(Cells(2, 22))
End If
 
 If Sheets("GENERAL").Range("W" & Range("W65536").End(xlUp).Row).Value <> Sheets("GENERAL").Range("W" & Range("W1").Row + 1).Value Then
 Range("W" & Range("W65536").End(xlUp).Row + 1).Value = CDbl(Cells(2, 23))
End If
 
 If Sheets("GENERAL").Range("X" & Range("X65536").End(xlUp).Row).Value <> Sheets("GENERAL").Range("X" & Range("X1").Row + 1).Value Then
 Range("X" & Range("X65536").End(xlUp).Row + 1).Value = CDbl(Cells(2, 24))
End If
 
 If Sheets("GENERAL").Range("Y" & Range("Y65536").End(xlUp).Row).Value <> Sheets("GENERAL").Range("Y" & Range("Y1").Row + 1).Value Then
 Range("Y" & Range("Y65536").End(xlUp).Row + 1).Value = CDbl(Cells(2, 25))
End If
 
If Sheets("GENERAL").Range("Z" & Range("Z65536").End(xlUp).Row).Value <> Sheets("GENERAL").Range("Z" & Range("Z1").Row + 1).Value Then
 Range("Z" & Range("Z65536").End(xlUp).Row + 1).Value = CDbl(Cells(2, 26))
End If
 
 If Sheets("GENERAL").Range("AA" & Range("AA65536").End(xlUp).Row).Value <> Sheets("GENERAL").Range("AA" & Range("AA1").Row + 1).Value Then
 Range("AA" & Range("AA65536").End(xlUp).Row + 1).Value = CDbl(Cells(2, 27))
End If
 
If Sheets("GENERAL").Range("AB" & Range("AB65536").End(xlUp).Row).Value <> Sheets("GENERAL").Range("AB" & Range("AB1").Row + 1).Value Then
 Range("AB" & Range("AB65536").End(xlUp).Row + 1).Value = CDbl(Cells(2, 28))
End If
 
 If Sheets("GENERAL").Range("AC" & Range("AC65536").End(xlUp).Row).Value <> Sheets("GENERAL").Range("AC" & Range("AC1").Row + 1).Value Then
 Range("AC" & Range("AC65536").End(xlUp).Row + 1).Value = CDbl(Cells(2, 29))
End If
 
 If Sheets("GENERAL").Range("AD" & Range("AD65536").End(xlUp).Row).Value <> Sheets("GENERAL").Range("AD" & Range("AD1").Row + 1).Value Then
 Range("AD" & Range("AD65536").End(xlUp).Row + 1).Value = CDbl(Cells(2, 30))
End If
 
If Sheets("GENERAL").Range("AE" & Range("AE65536").End(xlUp).Row).Value <> Sheets("GENERAL").Range("AE" & Range("AE1").Row + 1).Value Then
 Range("AE" & Range("AE65536").End(xlUp).Row + 1).Value = CDbl(Cells(2, 31))
End If
 
 
End Sub

02/01/2015, 18h06
casefayere
Bonjour,

je n'ai pas trop le temps mais rien que cette partie, tu éviteras les "Select"
Code:

1 2 3 4 5 Rows("2:2").Select Selection.Copy Range("A3").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False
peut se traduire par

Code:

Rows("3").Value = Rows("2").Value

le reste peut passer par une boucle, voire par des variables "Tableau", mais manque de temps pour expliquer
02/01/2015, 18h36
laurent481826

Merci pour la piste casefayere :) ...

Vite fait, pour le reste, il suffirait de, à adapter

Code:

1
2
3
4
5
6
7
8
9
Dim x As Long
Rows("3").Value = Rows("2").Value
With Sheets("GENERAL")
  For x = 1 To 31
    If .Cells(.Rows.Count, x).End(xlUp) <> .Range("A" & x + 1) Then
      .Cells(.Rows.Count, x).End(xlUp)(2, 1) = CDbl(Cells(2, x))
    End If
  Next x
End With

02/01/2015, 19h37
laurent481826

Merci pour le temps que tu m'accordes casefayere ...
Sur la 1er colonne cela fonctionne bien mais pas sur les 30 suivantes !
Je vais essayer de bidouiller ;)
Je te tiens au courant su je trouve la sollution :D
03/01/2015, 09h43
casefayere

Bonjour,

En attendant, une petite remarque, quand tu écris

Code:

....Range("A1").Row + 1..

cela revient à écrire "2" donc

Code:

<> Sheets("GENERAL").Range("A" & Range("A1").Row + 1)

s'écrit

Code:

<> Sheets("GENERAL").Range("A2")

:mouarf:

Effectivement casefayere :D merci ...
En ce qui concerne ton code !!!! il est parfait ... je ne comprend pas pourquoi il ne fonctionne pas.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Sub ReleveCotations() Rows("3").Value = Rows("2").Value Application.Run ("MyMacro") End Sub Sub MyMacro() Application.OnTime Now + TimeValue("00:00:01"), "MyMacro" Dim x As Long With Sheets("GENERAL") For x = 1 To 31 If .Cells(.Rows.Count, x).End(xlUp) <> .Range("A" & x + 1) Then .Cells(.Rows.Count, x).End(xlUp)(2, 1) = CDbl(Cells(2, x)) End If Next x End With End Sub
Cela fonctionne convenablement pour la colonne A mais pas pour les suivantes, en effet malgré la demande de comparaison entre par exemple B2 et la dernière cellule pleine de la colonne B la macro copie la valeur inchangée présente en B2 alors que cela ne devrait pas être le cas et ce indéfiniment.

Tu saurais pourquoi le boulot n'est fait convenablement que sur la colonne A ?

Ca y est !! c'est bon :mrgreen:

J'ai remplacé ca

Code:

If .Cells(.Rows.Count, x).End(xlUp) <> .Range("A" & x + 1) Then

par ça

Code:

If .Cells(.Rows.Count, x).End(xlUp) <> .Cells(2, x) Then

Merci beaucoup pour ton aide casefayere

Voici le code final ...
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Sub ReleveCotations() Rows("3").Value = Rows("2").Value Application.Run ("MyMacro") End Sub Sub MyMacro() Application.OnTime Now + TimeValue("00:00:01"), "MyMacro" Dim x As Long With Sheets("GENERAL") For x = 1 To 31 If .Cells(.Rows.Count, x).End(xlUp) <> .Cells(2, x) Then .Cells(.Rows.Count, x).End(xlUp)(2, 1) = CDbl(Cells(2, x)) End If Next x End With End Sub
S'il est possible de l’alléger encore afin que cela aille plus vite n'hésitez pas ;)

Citation:

Ca y est !! c'est bon

eh oui, je t'ai prévenu, j'ai fait un code vite fait avec ce que tu fournis.

Citation:

S'il est possible de l’alléger encore afin que cela aille plus vite n'hésitez pas

comme je ne connais pas ton fichier, la boucle tournant sur 31 pas, je ne vois pas pourquoi la procédure est si longue à s'executer, essayes en ajoutant, pour tester, en haut et en bas de la procédure
Code:

1 2 3 4 5 6 7 Application.ScreenUpdating = False Application.Calculation = xlCalculationManual '............ '................ Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic

03/01/2015, 18h49
laurent481826

C'est déjà énorme casefayere ! vraiment merci :)

Ce n'est pas super long effectivement mais la procédure prend environ 2 à 3 secondes (de 1 à 31 colonne) mais il se pourrait que je rajoute d'autres cours de bourse (donc plus de colonne)
Du coup, plus la procédure est longue moins les relevés seront fréquents et moins l'analyse graphique sera bonne.

Je ne pourrais tester ton dernier conseil que lundi après l'ouverture du Forex.
Je te tiens au jus ;)
25/01/2015, 13h36
laurent481826

Merci encore pour ton aide ! tout est parfait :)