Peut on améliorer ce code

**johannj** · 03/04/2009, 12h08

Bonjour à tous,

Je précise tout de suite que ce post n'est pas urgent et que si vous préférez "secourir" d'autres programmeurs débutants comme je le suis, pas de problème.

Voilà, depuis quelques mois je demande beaucoup d'informations afin d'automatiser certaines taches. Je viens de finir la syntaxe principale d'une macro, bien qu'il me reste encore des petits trucs à ajouter.
Je souhaitais seulement soumettre ce code au forum pour savoir comment et où puis-je améliorer ce code.
Je remercie par la même occasion tous ceux qui m'ont aidé, notamment Qwazerty et PGZ pour leurs conseils.

Voici le code (je le mets aussi en pièces jointes)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
Sub IV()
'ouverture de la reference
 
Dim OpenReference As String, nom As String 
    Dim Reference As Workbook 'definition de Reference comme workbook
    Dim i As Integer, j As Integer
    Dim light As Single, Voc As Single, FillF As Single, Jsc As Single, efficiency As Single
    Dim tableau
 
    OpenReference = Application.GetOpenFilename(fileFilter:=",*.CSV") 
 
    Set Reference = Application.Workbooks.Open(OpenReference) 
 
    Application.ScreenUpdating = False      'Desactive la mise a jour de l'ecran pour gagner du temps
 
    With Reference
        nom = Reference.Worksheets(1).Name
        .Worksheets(1).Name = "Brut Data"
        .Sheets.Add After:=ActiveSheet, Count:=4
        .Worksheets(2).Name = "Correction"
        .Worksheets(3).Name = "Kennlinie"
        .Worksheets(4).Name = "Ergebnisse"
        .Worksheets(5).Name = "Einstellungen"
    End With
 
light = Application.WorksheetFunction.Average(Worksheets(1).Range("G2:G101"))
 
    With Reference.Worksheets(2)
        .Range("A1:M1").Value = Array("P", "U", "I", "U", "Light", "T", "", "P_Corrected", "U_Corrected", "I_Corrected", "U_Corrected", "P_Diagram", "Gerade")
        .Range("N1:AA1").Value = Array("Nebenrechnungen ISC", "Strom vor ISC", "Index des Stroms", "1/2 Messpunkte für Steigung", "U/I vor ISC", "U/I nach ISC", "ISC", "Nebenrechnungen Voc", "Spannung vor Voc", "Index des Stroms", "I/U vor Voc", "I/U nach ISC", "Voc", "Test Steigung")
        .Range("N1:AA1").Copy
        .Range("N2").PasteSpecial Transpose:=True
        .Range("N1:AA1").ClearContents
        .Columns("N:N").EntireColumn.AutoFit
        .Range("O5,Q5").Value = "8"
        .Range("8:8,9:10,14:14,15:15").Insert Shift:=xlDown
        .Range("O1:Q1").Value = Array("Corrected", "", "Uncorrected")
 
        For i = 2 To 101
            .Range("B" & i).Value = "='Brut Data'!B" & CInt(i) & ""
            .Range("C" & i).Value = "='Brut Data'!D" & CInt(i) & ""
            .Range("D" & i).Value = "='Correction'!B" & CInt(i) & ""
            .Range("E" & i).Value = "='Brut Data'!G" & CInt(i) & ""
            .Range("F" & i).Value = "='Brut Data'!F" & CInt(i) & ""
            .Range("A" & i).Value = "=B" & CInt(i) & "*C" & CInt(i) & "/Einstellungen!B3*1000000"
            .Range("I" & i).Value = "=(ABS(B" & CInt(i) & ")*1000+(Einstellungen!B2-F" & CInt(i) & ")*Einstellungen!B1)*SIGN(B" & CInt(i) & ")"
            .Range("J" & i).Value = "=C" & CInt(i) & "*Einstellungen!B4/E" & CInt(i) & "/Einstellungen!B3*1000"
            .Range("K" & i).Value = "=I" & CInt(i) & ""
            .Range("H" & i).Value = "=J" & CInt(i) & "*I" & CInt(i) & ""
            .Range("L" & i).Value = "=H" & CInt(i) & "/500"
        Next i
 
        .Range("O3").Value = "=VLOOKUP(0,I2:J101,2,-1)"
        .Range("Q3").Value = "=VLOOKUP(0,B2:C101,2,-1)"
        .Range("O4").Value = "=Match(O3,J2:J101,0)"
        .Range("Q4").Value = "=Match(Q3,C2:C101,0)"
        .Range("O6").Value = "=Index(I2:J101,O4,1)"
        .Range("P6").Value = "=Index(I2:J101,O4,2)"
        .Range("Q6").Value = "=Index(B2:C101,Q4,1)"
        .Range("R6").Value = "=Index(B2:C101,Q4,2)"
        .Range("O7").Value = "=INDEX(I2:J101,O4+1,1)"
        .Range("P7").Value = "=Index(I2:J101,O4+1,2)"
        .Range("Q7").Value = "=INDEX(B2:C101,Q4+1,1)"
        .Range("R7").Value = "=INDEX(B2:C101,Q4+1,2)"
        .Range("O9").Value = "=(O7*P6-P7*O6)/(O7-O6)"
        .Range("Q9").Value = "=(Q7*R6-Q6*R7)/(Q7-Q6)/Einstellungen!B3*1000"
        .Range("O13").Value = "=VLOOKUP(0,J2:K101,2,-1)"
        .Range("Q13").Value = "=VLOOKUP(0,C2:D101,2,-1)"
        .Range("O14").Value = "=Match(O13,K2:K101,0)"
        .Range("Q14").Value = "=Match(Q13,D2:D101,0)"
        .Range("O15").Value = "=Index(J2:K101,O14,1)"
        .Range("P15").Value = "=Index(J2:K101,O14,2)"
        .Range("Q15").Value = "=Index(C2:D101,Q14,1)"
        .Range("R15").Value = "=Index(C2:D101,Q14,2)"
        .Range("O16").Value = "=INDEX(J2:K101,O14+1,1)"
        .Range("P16").Value = "=INDEX(J2:K101,O14+1,2)"
        .Range("Q16").Value = "=INDEX(C2:D101,Q14+1,1)"
        .Range("R16").Value = "=INDEX(C2:D101,Q14+1,2)"
        .Range("O18").Value = "=(O16*P15-O15*P16)/(O16-O15)"
        .Range("Q18").Value = "=(Q16*R15-Q15*R16)/(Q16-Q15)*1000"
        .Range("O20").Value = "=index(LINEST(J7:J21,I7:I21,1),1,1)" 'renvoie la pente
        .Range("P20").Value = "=index(LINEST(J7:J21,I7:I21,1),1,2)" 'renvoie l'ordonnee a l'origine
        For j = 7 To 21
            .Range("M" & j).Value = "=(I" & CInt(j) & "*Correction!O20)+Correction!P20"
        Next j
    End With
 
    With Reference.Worksheets(4)
        .Range("A2:G2").Value = Array("P_mpp", "V_mpp", "I_mpp", "Efficiency", "Isc", "Voc", "FF")
        .Range("B2:G2").Copy
        .Range("A3").PasteSpecial Transpose:=True
        .Range("B2:G2").ClearContents
        .Range("B1:G1").Value = Array("Corrected", "", "uncorrected", "", "It.Messgerät", "")
        .Range("A10:G10").Value = Array("µW/cm2", "mV", "mA/cm2", "%", "mA/cm2", "mV", "%")
        .Range("A10:G10").Copy
        .Range("C2,E2,G2").PasteSpecial Transpose:=True
        .Range("A10:G10").ClearContents
 
        .Range("B2").Value = "=MIN(Correction!H2:H101)"
        .Range("D2").Value = "=MIN(Correction!A2:A101)"
        .Range("B3").Value = "=VLOOKUP(B2,Correction!H2:I101,2,0)"
        .Range("D3").Value = "=VLOOKUP(D2,Correction!A2:B101,2,0)*1000"
        .Range("B4").Value = "=B2/B3"
        .Range("D4").Value = "=D2/D3"
        .Range("B5").Value = "=ABS(B2/1000)"
        .Range("D5").Value = "=ABS(D2/1000)"
        .Range("B6").Value = "=Correction!O9"
        .Range("D6").Value = "=Correction!Q9"
        .Range("B7").Value = "=Correction!O18"
        .Range("D7").Value = "=Correction!Q18"
        .Range("B8").Value = "=((B3*B4)/(B6*B7))*100"
        .Range("D8").Value = "=((D3*D4)/(D6*D7))*100"
     End With
 
    With Reference.Worksheets(5)
        .Range("A1:C1").Value = Array("Voc(T)", "-2.25", "mv/°C")
        .Range("A2:C2").Value = Array("T_Standard", "25", "°C")
        .Range("A3:C3").Value = Array("Fläche", "243.36", "cm2")
        .Range("A4:B4").Value = Array("Licht", light)
    End With
 
dessiner
 
Voc = Reference.Worksheets(4).Range("B7").Value
Jsc = Reference.Worksheets(4).Range("B6").Value
FillF = Reference.Worksheets(4).Range("B8").Value
efficiency = Reference.Worksheets(4).Range("B5").Value
tableau = Split(nom, "_")
nom = tableau(1)
 
Application.ScreenUpdating = True
'Application.SaveAs (nom)
 
Set Reference = Nothing
 
End Sub
 
 
Function dessiner()
 
Dim Chrt As Excel.ChartObject, oChrt As Excel.ChartObject
Dim plot As Excel.Chart, plot1 As Excel.Chart
Dim maSerie As Excel.Series
Dim minimum As Single, maximum As Single
 
minimum = Application.WorksheetFunction.Min(Worksheets(2).Range("M7:M21"))
minimum = minimum - 0.1
 
maximum = Application.WorksheetFunction.Max(Worksheets(2).Range("M7:M21"))
maximum = maximum + 0.1
 
 
    With Worksheets(3)
        Set Chrt = .ChartObjects.Add(.Range("B2").Left, .Range("B2").Top, 400, 300)
        Set oChrt = .ChartObjects.Add(.Range("B30").Left, .Range("B30").Top, 400, 300)
    End With
 
    Set plot = Chrt.Chart
 
    plot.SeriesCollection.NewSeries
    With plot
       .SeriesCollection(1).ChartType = xlXYScatterSmooth
       .SeriesCollection(1).Name = "I(V) Corrected"
       .SeriesCollection(1).XValues = "=Correction!R2C9:R101C9"
       .SeriesCollection(1).Values = "=Correction!R2C10:R101C10"
       .Legend.Delete 'supprime la legende
       .Axes(xlCategory, xlPrimary).HasTitle = True
       .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "V Corrected"
       .Axes(xlValue, xlPrimary).HasTitle = True
       .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "I croo" 
       .SeriesCollection(1).MarkerBackgroundColorIndex = 50 
       .SeriesCollection(1).MarkerForegroundColorIndex = 50 
       .SeriesCollection(1).Border.ColorIndex = 50 
       .PlotArea.Border.ColorIndex = 57 
       .PlotArea.Interior.ColorIndex = 2 'met le fond du graph en blanc
    End With
 
    Set plot1 = oChrt.Chart
 
    plot1.SeriesCollection.NewSeries
    plot1.SeriesCollection.NewSeries
 
    With plot1
       .SeriesCollection(1).ChartType = xlXYScatterSmooth
       .SeriesCollection(1).Name = "I(V) Corrected"
       .SeriesCollection(1).XValues = "=Correction!R2C9:R101C9"
       .SeriesCollection(1).Values = "=Correction!R2C10:R101C10"
 
       .SeriesCollection(2).ChartType = xlXYScatterSmooth
       .SeriesCollection(2).Name = "I(V) Corrected"
       .SeriesCollection(2).XValues = "=Correction!R7C9:R21C9"
       .SeriesCollection(2).Values = "=Correction!R7C13:R21C13"
       .Legend.Delete 'supprime la legende
       .Axes(xlCategory, xlPrimary).HasTitle = True
       .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "V Corrected"
       .Axes(xlCategory).MinimumScale = -100
       .Axes(xlCategory).MaximumScale = 100
       .Axes(xlValue, xlPrimary).HasTitle = True
       .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "I croo" 
       .Axes(xlValue).MaximumScale = maximum
       .Axes(xlValue).MinimumScale = minimum
       .SeriesCollection(2).MarkerBackgroundColorIndex = 53 
       .SeriesCollection(2).MarkerForegroundColorIndex = 53 
       .SeriesCollection(2).MarkerStyle = xlDash 'change le type de marqueur
       .SeriesCollection(2).Border.ColorIndex = 53 
       .SeriesCollection(2).Border.Weight = xlThick 'change l'epaisseur
       .PlotArea.Border.ColorIndex = 57 
       .PlotArea.Interior.ColorIndex = 2 
    End With
 
    Set plot = Nothing
    Set oChrt = Nothing
    Set plot1 = Nothing
    Set Chrt = Nothing
 
End Function

Merci,

Johann

**La Zélie** · 03/04/2009, 13h38

Bonjour johannj et le forum

Remplacer les "copy" par cut

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 .Range("N1:AA1").Copy
        .Range("N2").PasteSpecial Transpose:=True
        .Range("N1:AA1").ClearContents

A mon avis, cela fait la même chose et la ligne du clearcontents serait inutile

**johannj** · 03/04/2009, 14h09

Bonjour la Zélie,

Merci pour l'info..

J'aurai pu y penser tout seul

Peut on améliorer ce code

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager