Optimiser codes vba

johndoe47 · 9 Septembre 2011

Bonjour, je fais appel à vous car j'ai réaliser quelques macros, elles fonctionnent très bien cependant j'aurais voulu savoir comment optimiser leur temps d'exécution.

J'aurais aimé aussi savoir si l'on peut afficher une boite de message qui mettrait en attente l'utilisateur pendant l'exécution.

Y-a-t-il moyen de rester sur la page où on exécute la macro plutôt que de voir naviguer le curseur dans les différentes feuilles?

Je vous joins 3 macros, les plus longues:

Code:

Sub Changement_de_session()

Sheets("Récap par stagiaire").Select
Selection.Activate

'si session désirée vide, message box
If Range("N2").Value = "" Then
If MsgBox("Sélectionner la session désirée") = vbOK Then Exit Sub
End If

'copie de la ligne de valeurs pour conserver ancien emplacement du stagiaire
Sheets("Récap par stagiaire").Range("AF5").Select
    Selection.Copy
    Sheets("Récap par stagiaire").Range("AG5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Dim i&

For i = 400 To 7 Step -1
Z = Sheets("Récap par stagiaire").Range("AM" & i).Value 'première ligne libre dans sessions
Y = Sheets("Récap par stagiaire").Range("AG5").Value 'ligne valeurs ancien emplacement

'si session désirée coincide avec session dispo, alors s'il y a des places, copier les valeurs
If Range("N2").Value = Range("L" & i).Value Then
If Range("O" & i).Value = 0 Then
MsgBox ("Session pleine")
Else
If Range("O" & i).Value > 0 Then
'copie des valeurs
Sheets("Suivi Sessions").Activate
Sheets("Suivi Sessions").Range("D" & Y).Resize(1, 15).Select
Selection.Copy
Sheets("Suivi Sessions").Range("D" & Z).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

Sheets("Suivi Sessions").Range("T" & Z).Value = Sheets("Suivi Sessions").Range("T" & Y).Value
Sheets("Suivi Sessions").Range("U" & Z).Value = Sheets("Suivi Sessions").Range("U" & Y).Value
Sheets("Suivi Sessions").Range("W" & Z).Value = Sheets("Suivi Sessions").Range("W" & Y).Value
Sheets("Suivi Sessions").Range("X" & Z).Value = Sheets("Suivi Sessions").Range("X" & Y).Value
Sheets("Suivi Sessions").Range("Z" & Z).Value = Sheets("Suivi Sessions").Range("Z" & Y).Value

Sheets("Suivi Sessions").Range("AA" & Y).Resize(1, 13).Copy
Sheets("Suivi Sessions").Range("AA" & Z).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

Sheets("Suivi Sessions").Range("AO" & Y).Resize(1, 7).Copy
Sheets("Suivi Sessions").Range("AO" & Z).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

Sheets("Suivi Sessions").Range("AW" & Y).Resize(1, 7).Copy
Sheets("Suivi Sessions").Range("AW" & Z).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

Sheets("Suivi Sessions").Range("BE" & Y).Resize(1, 4).Copy
Sheets("Suivi Sessions").Range("BE" & Z).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

       
    m = Sheets("Récap par stagiaire").Range("AQ4").Value 'pour ancienne ligne concernée (gauche)
    n = Sheets("Récap par stagiaire").Range("AQ5").Value 'pour haut gauche de la session
    o = Sheets("Récap par stagiaire").Range("AZ5").Value 'pour haut gauche de la session
    p = Sheets("Récap par stagiaire").Range("AZ4").Value 'pour ligne courante (gauche)
    q = Sheets("Récap par stagiaire").Range("AS5").Value 'pour ligne haut gauche zone à droite du tableau
       
       'copie de la ligne de formule de base sur l'ancien emplacement du stagiaire
    Sheets("Suivi Sessions").Activate
    Sheets("Suivi Sessions").Range("D17:BH17").Select
    Selection.Copy
    Sheets("Suivi Sessions").Range(m).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
 'tri de l'ancienne session
 With Sheets("Suivi Sessions")
        .Range(n).Resize(12, 57).Select
        Selection.Sort Key1:=Range(n), Order1:=xlAscending, Header:=xlNo, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    End With
 
 'tri de la nouvelle session
     Sheets("Suivi Sessions").Activate
With Sheets("Suivi Sessions")
        .Range(o).Resize(12, 57).Select
        Selection.Sort Key1:=Range(o), Order1:=xlAscending, Header:=xlNo, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    End With

'désélectionner
Sheets("Suivi Sessions").Range(p).Select

Sheets("Récap par stagiaire").Activate
Sheets("Récap par stagiaire").Range("H11").Select

End If
End If
End If

Next
'actualise les places sessions
Call Actualiser_Places_Sessions

'efface session désirée
Sheets("Récap par stagiaire").Activate
Sheets("Récap par stagiaire").Range("N2").ClearContents
Sheets("Récap par stagiaire").Range("H11").Select
'message stagiaire transféré
session = "Stagiaire transféré vers la session " & Sheets("Récap par stagiaire").Range("D4").Value
MsgBox ([session])

End Sub

Code:

Sub Ajouter_à_la_session()
'si session voulue vide, message box, sinon copie des valeurs
If Range("D5").Value = "" Then
If MsgBox("Veuillez choisir une session") = vbOK Then Exit Sub
End If

'copie des valeurs
Dim i&
For i = 400 To 2 Step -1
Z = Sheets("Ajouter stagiaire").Range("U" & i).Value 'première cellule vide de la session

'si session coincide avec session dispo, et si places dispo, alors copier valeurs
If Range("D5").Value = Range("K" & i).Value Then
If Range("N" & i).Value = 0 Then
MsgBox ("Session pleine")
Else
'copie des valeurs
If Range("N" & i).Value > 0 Then
Sheets("Suivi Sessions").Range("D" & Z).Value = Range("D2").Value
Sheets("Suivi Sessions").Range("E" & Z).Value = Range("D3").Value
Sheets("Suivi Sessions").Range("F" & Z).Value = Range("D8").Value
Sheets("Suivi Sessions").Range("G" & Z).Value = Range("D9").Value
Sheets("Suivi Sessions").Range("H" & Z).Value = Range("D10").Value
Sheets("Suivi Sessions").Range("I" & Z).Value = Range("D11").Value
Sheets("Suivi Sessions").Range("J" & Z).Value = Range("D12").Value
Sheets("Suivi Sessions").Range("BH" & Z).Value = Range("D13").Value

'copier nom + prénom dans la feuille Récap
Sheets("Récap par stagiaire").Range("D2:F2") = Sheets("Ajouter Stagiaire").Range("AG3")

'Trier la session de destination
n = Sheets("Récap par stagiaire").Range("AZ5").Value
o = Sheets("Récap par stagiaire").Range("AZ4").Value
Sheets("Suivi Sessions").Activate
With Sheets("Suivi Sessions")
        .Range(n).Resize(12, 56).Select
        Selection.Sort Key1:=Range(n), Order1:=xlAscending, Header:=xlNo, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    End With
Range(o).Select

'remise à plat de la feuille ajouter stagiaire
Sheets("Ajouter Stagiaire").Activate
Range("X2:X16").Select
Selection.Copy
Range("D2:F2").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("H11").Select

End If
End If
End If

Next

'actualiser places session
   Call Actualiser_Places_Sessions
   session = "Stagiaire ajouté à la session " & Range("D5").Value
MsgBox ([session])

   End Sub

Code:

Sub Actualiser_Places_Sessions()

Application.CutCopyMode = False
  'chercher valeurs de sessions
    For i = 2 To 100
    'copier toutes les références de sessions
    Sheets("Ajouter stagiaire").Range("K" & i) = Sheets("Suivi Sessions").Range("C" & Sheets("Ajouter stagiaire").Range("AC" & i).Value)
    'si référence de session présente, copier lieu, date, et nombre de places dispo
    If Sheets("Suivi Sessions").Range("C" & Sheets("Ajouter stagiaire").Range("AC" & i).Value) <> "" Then
    Sheets("Ajouter stagiaire").Range("L" & i) = Sheets("Suivi Sessions").Range("BL" & Sheets("Ajouter stagiaire").Range("AC" & i).Value)
    Sheets("Ajouter stagiaire").Range("M" & i) = Sheets("Suivi Sessions").Range("BK" & Sheets("Ajouter stagiaire").Range("AC" & i).Value)
    Sheets("Ajouter stagiaire").Range("N" & i) = Sheets("Suivi Sessions").Range("H" & Sheets("Ajouter stagiaire").Range("AC" & i).Value)
    
    End If
    
    Next i
    'mise en forme du tableau de données
    Sheets("Ajouter stagiaire").Activate
    Sheets("Ajouter stagiaire").Range("K2").Copy
    Sheets("Ajouter stagiaire").Range("K3:K100").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
    Sheets("Ajouter stagiaire").Range("L2").Select
    Selection.Copy
    Sheets("Ajouter stagiaire").Range("L3:L100").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    
    Sheets("Ajouter stagiaire").Range("M2").Copy
    Sheets("Ajouter stagiaire").Range("M3:M100").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False

    Sheets("Ajouter stagiaire").Range("N2").Copy
    Sheets("Ajouter stagiaire").Range("N3:N100").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False

    Sheets("Ajouter stagiaire").Range("H10").Select
End Sub

flyonets44 · 9 Septembre 2011

Re : Optimiser codes vba

bonjour
pour accélerer le traitement
en début de macro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
en fin de macro
Application.Calculation = xlCalculationAutomatic
end sub
Cordialement

flyonets44 · 9 Septembre 2011

Re : Optimiser codes vba

Bonjour
j'ai oublié
tu peux éviter les select
Sheets("Ajouter stagiaire").Range("L2").Select
Selection.Copy
devient Sheets("Ajouter stagiaire").Range("L2").copy
Cordialement
flyonets

kjin · 9 Septembre 2011

Re : Optimiser codes vba

Bonjour,
Utilises le plus possible l'instruction With/End With, déclares les variables car là en l'occurence on ne sait rien de leur type, évites le copier/collage special si tu n'as que des valeurs à transférer, désactives le calcul auto s'il y a beaucoup de formules...
Note qu'avec juste un bout de code il est difficile d'en dire plus

Code:

Sub Changement_de_session()
Dim i& 'et les autres variables ???
With Sheets("Récap par stagiaire")
    m = .Range("AQ4").Value 'pour ancienne ligne concernée (gauche)
    n = .Range("AQ5").Value 'pour haut gauche de la session
    o = .Range("AZ5").Value 'pour haut gauche de la session
    p = .Range("AZ4").Value 'pour ligne courante (gauche)
    q = .Range("AS5").Value 'pour ligne haut gauche zone à droite du tableau
    'si session désirée vide, message box
    If .Range("N2").Value = "" Then
        If MsgBox("Sélectionner la session désirée") = vbOK Then Exit Sub
    End If
    'copie de la ligne de valeurs pour conserver ancien emplacement du stagiaire
    .Range("AG5") = .Range("AF5")
    For i = 400 To 7 Step -1
        z = .Range("AM" & i).Value 'première ligne libre dans sessions
        y = .Range("AG5").Value 'ligne valeurs ancien emplacement
        'si session désirée coincide avec session dispo, alors s'il y a des places, copier les valeurs
        If .Range("N2").Value = .Range("L" & i).Value Then
            If .Range("O" & i).Value = 0 Then
                MsgBox ("Session pleine")
            Else
                'copie des valeurs
                With Sheets("Suivi Sessions")
                    .Range("D" & y).Resize(1, 15).Copy .Range("D" & z)
                    .Range("T" & z).Value = .Range("T" & y).Value
                    .Range("U" & z).Value = .Range("U" & y).Value
                    .Range("W" & z).Value = .Range("W" & y).Value
                    .Range("X" & z).Value = .Range("X" & y).Value
                    .Range("Z" & z).Value = .Range("Z" & y).Value
                    .Range("AA" & y).Resize(1, 13).Copy .Range("AA" & z)
                    .Range("AO" & y).Resize(1, 7).Copy .Range("AO" & z)
                    .Range("AW" & y).Resize(1, 7).Copy .Range("AW" & z)
                    .Range("BE" & y).Resize(1, 4).Copy .Range("BE" & z)
                    .Range("D17:BH17").Copy
                    .Range(m).PasteSpecial Paste:=xlPasteFormulas
                    Application.CutCopyMode = False
                    .Range(n).Resize(12, 57).Sort Key1:=Range(n), Order1:=xlAscending, Header:=xlNo, _
                        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
                End With
            End If
        End If
    Next
    'actualise les places sessions
    Call Actualiser_Places_Sessions
    .Range("N2").ClearContents
End With

session = "Stagiaire transféré vers la session " & Sheets("Récap par stagiaire").Range("D4").Value
MsgBox ([session])

End Sub

A+
kjin

Theze · 9 Septembre 2011

Re : Optimiser codes vba

Bonjour,

J'ai retouché tes procs mais évite autant que possible les Activate et Select car ça fait scintiller Excel et ralenti le traitement. Indente aussi tes blocs d'instruction, le code devient alors bien plus facile à lire et tu peux aussi l'aérer en mettant des lignes vides entre certaines instructions. Quand tu travaille sur plusieurs feuilles, utilise des variables, le traitement est aussi plus rapide :

Code:

Sub Changement_de_session()

    Dim FeSession As Worksheet
    Dim FeRecap As Worksheet
    Dim I As Integer
    
    Set FeSession = Worksheets("Suivi Sessions")
    Set FeRecap = Worksheets("Récap par stagiaire")
    
    'si session désirée vide, message box
    If FeRecap.Range("N2").Value = "" Then
    
        If MsgBox("Sélectionner la session désirée") = vbOK Then Exit Sub
        
    End If
    
    'copie de la ligne de valeurs pour conserver ancien emplacement du stagiaire
    FeRecap.Range("AF5").Copy FeRecap.Range("AG5")
    
    For I = 400 To 7 Step -1
    
        Z = FeRecap.Range("AM" & I).Value 'première ligne libre dans sessions
        Y = FeRecap.Range("AG5").Value 'ligne valeurs ancien emplacement
        
        'si session désirée coincide avec session dispo, alors s'il y a des places, copier les valeurs
        If Range("N2").Value = Range("L" & I).Value Then
        
            If Range("O" & I).Value = 0 Then
            
                MsgBox ("Session pleine")
                       
            Else
        
                If Range("O" & I).Value > 0 Then
                
                    'copie des valeurs
                    With FeSession
                    
                        .Range("D" & Y).Resize(1, 15).Copy .Range("D" & Z)
                    
                        .Range("T" & Z).Value = .Range("T" & Y).Value
                        .Range("U" & Z).Value = .Range("U" & Y).Value
                        .Range("W" & Z).Value = .Range("W" & Y).Value
                        .Range("X" & Z).Value = .Range("X" & Y).Value
                        .Range("Z" & Z).Value = .Range("Z" & Y).Value
                    
                        .Range("AA" & Y).Resize(1, 13).Copy .Range("AA" & Z)
                    
                        .Range("AO" & Y).Resize(1, 7).Copy .Range("AO" & Z)
                    
                        .Range("AW" & Y).Resize(1, 7).Copy .Range("AW" & Z)
                    
                        .Range("BE" & Y).Resize(1, 4).Copy .Range("BE" & Z)
                           
                        m = FeRecap.Range("AQ4").Value 'pour ancienne ligne concernée (gauche)
                        n = FeRecap.Range("AQ5").Value 'pour haut gauche de la session
                        o = FeRecap.Range("AZ5").Value 'pour haut gauche de la session
                        p = FeRecap.Range("AZ4").Value 'pour ligne courante (gauche)
                        q = FeRecap.Range("AS5").Value 'pour ligne haut gauche zone à droite du tableau
                           
                        'copie de la ligne de formule de base sur l'ancien emplacement du stagiaire
                        .Range("D17:BH17").Copy .Range(m)
                            
                        Application.CutCopyMode = False
                       
                        'tri de l'ancienne session
                        .Range(n).Resize(12, 57).Sort .Range(n), xlAscending, , , , , , xlNo, 1, False, xlTopToBottom
                                    
                        'tri de la nouvelle session
                        .Range(o).Resize(12, 57).Sort .Range(o), xlAscending, , , , , , xlNo, 1, False, xlTopToBottom
                                                       
                    End With
                    
                End If
            
            End If
        
        End If
    
    Next I
    
    'actualise les places sessions
    Actualiser_Places_Sessions
    
    'efface session désirée
    With FeRecap
    
        .Activate
        .Range("N2").ClearContents
        .Range("H11").Select
        
    End With
    
    'message stagiaire transféré
    MsgBox "Stagiaire transféré vers la session " & FeRecap.Range("D4").Value
    
End Sub

Sub Ajouter_à_la_session()

    Dim FeSession As Worksheet
    Dim FeRecap As Worksheet
    Dim I As Integer
    
    Set FeSession = Worksheets("Suivi Sessions")
    Set FeRecap = Worksheets("Récap par stagiaire")


    'si session voulue vide, message box, sinon copie des valeurs
    
    '>>>> Sur quelle feuille ?????
    If Range("D5").Value = "" Then
    
        If MsgBox("Veuillez choisir une session") = vbOK Then Exit Sub
        
    End If
    
    'copie des valeurs
    For I = 400 To 2 Step -1
    
        Z = Sheets("Ajouter stagiaire").Range("U" & I).Value 'première cellule vide de la session
        
        'si session coincide avec session dispo, et si places dispo, alors copier valeurs
        If Range("D5").Value = Range("K" & I).Value Then
        
            If Range("N" & I).Value = 0 Then
            
                MsgBox ("Session pleine")
                
            Else
            
            'copie des valeurs
                If Range("N" & I).Value > 0 Then
                    
                    With FeSession
                    
                        .Range("D" & Z).Value = .Range("D2").Value
                        .Range("E" & Z).Value = .Range("D3").Value
                        .Range("F" & Z).Value = .Range("D8").Value
                        .Range("G" & Z).Value = .Range("D9").Value
                        .Range("H" & Z).Value = .Range("D10").Value
                        .Range("I" & Z).Value = .Range("D11").Value
                        .Range("J" & Z).Value = .Range("D12").Value
                        .Range("BH" & Z).Value = .Range("D13").Value
                    
                        'copier nom + prénom dans la feuille Récap
                        .Range("D2:F2") = Sheets("Ajouter Stagiaire").Range("AG3")
                    
                        'Trier la session de destination
                        n = FeRecap.Range("AZ5").Value
                        o = FeRecap.Range("AZ4").Value
                        Sheets("Suivi Sessions").Activate
                    
                        .Range(n).Resize(12, 56).Sort .Range(n), xlAscending, , , , , , xlNo, 1, False, xlTopToBottom
                    
                    End With
                    
                    'remise à plat de la feuille ajouter stagiaire
                    With Sheets("Ajouter Stagiaire")
                    
                        .Range("X2:X16").Copy .Range("D2:F2")
                        
                    End With
                    
                End If
                
            End If
            
        End If
         
    Next I
    
    Application.CutCopyMode = False

    'actualiser places session
    Actualiser_Places_Sessions
       
    MsgBox "Stagiaire ajouté à la session " & Range("D5").Value
    
End Sub

Sub Actualiser_Places_Sessions()
    
    Dim FeStagiaire As Worksheet
    Dim I As Integer

    Set FeStagiaire = Worksheets("Ajouter stagiaire")
    
    With FeStagiaire
    
        'chercher valeurs de sessions
        For I = 2 To 100
            
             'copier toutes les références de sessions
             
            .Range("K" & I) = Sheets("Suivi Sessions").Range("C" & .Range("AC" & I).Value)
             
             'si référence de session présente, copier lieu, date, et nombre de places dispo
            If Sheets("Suivi Sessions").Range("C" & .Range("AC" & I).Value) <> "" Then
            
                .Range("L" & I) = Sheets("Suivi Sessions").Range("BL" & .Range("AC" & I).Value)
                .Range("M" & I) = Sheets("Suivi Sessions").Range("BK" & .Range("AC" & I).Value)
                .Range("N" & I) = Sheets("Suivi Sessions").Range("H" & .Range("AC" & I).Value)
            
            End If
       
        Next I
        
        'mise en forme du tableau de données
        .Range("K2").Copy .Range("K3:K100")
       
        .Range("L2").Copy .Range("L3:L100")
       
        .Range("M2").Copy .Range("M3:M100")
    
        .Range("N2").Copy .Range("N3:N100")
        
        Application.CutCopyMode = False
        
        .Activate
        .Range("H10").Select
        
    End With
    
End Sub

Hervé.

Effectuez une recherche sur Excel Downloads...

Optimiser codes vba

johndoe47

XLDnaute Nouveau

flyonets44

XLDnaute Occasionnel

flyonets44

XLDnaute Occasionnel

kjin

XLDnaute Barbatruc

Theze

XLDnaute Occasionnel

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums