IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Peut on améliorer ce code


Sujet :

Macros et VBA Excel

Mode arborescent

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre confirmé
    Profil pro
    Inscrit en
    Décembre 2008
    Messages
    124
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Décembre 2008
    Messages : 124
    Par défaut Peut on améliorer ce code
    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
    Fichiers attachés Fichiers attachés

Discussions similaires

  1. Réponses: 10
    Dernier message: 13/09/2011, 10h08
  2. Est ce que ce code peut être amélioré ?
    Par _s4z_ dans le forum Langage
    Réponses: 3
    Dernier message: 04/09/2010, 12h51
  3. [E-07]Peut-on améliorer ce code?
    Par rvtoulon dans le forum Macros et VBA Excel
    Réponses: 10
    Dernier message: 21/03/2009, 16h48
  4. [Optimisation]Peut-on améliorer ce code ?
    Par progfou dans le forum Algorithmes et structures de données
    Réponses: 6
    Dernier message: 09/08/2007, 15h43
  5. [EclipseUml] Peut-on générer le code ?
    Par Dof dans le forum Eclipse Java
    Réponses: 3
    Dernier message: 05/06/2003, 15h21

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo