Partager via

Excel VBA : amliorer vitesse d'une procédure

Anonyme
2021-02-20T13:00:53+00:00

Bonjour,

J'ai une procédure (ci-dessous) qui fait très bien le job, mais elle est très lente. Comment puis-je l'optimiser ?

Je remercie par avance toute personne qui pourra m'apporter son aide.

Sandra

Sub insererLig3() 'palettes complètes et pas complètes utilisées dans le fichier

    Dim lig As Long
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    For lig = Cells(Rows.Count, 2).End(xlUp).Row To 13 Step -1
        
        If Cells(lig, "B") <> Cells(lig + 1, "B") And Cells(lig, "S") = 2 Then

                 Rows(lig + 1).Resize(Cells(lig, "Q") - 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                
                 Cells(lig + 1, 2).Resize(Cells(lig, "Q") - 1, 1) = Cells(lig, "B")
                 Cells(lig + 1, 5).Resize(Cells(lig, "Q") - 1, 1) = Cells(lig, "E")
                 Cells(lig + 1, 7).Resize(Cells(lig, "Q") - 1, 1) = Cells(lig, "O")
                 Cells(lig + 1, 11).Resize(Cells(lig, "Q") - 1, 1) = Cells(lig, "K")
                 Cells(lig + 1, 12).Resize(Cells(lig, "Q") - 1, 1) = Cells(lig, "L")

                Cells(lig, "S").Offset(0, -12).Value = Cells(lig, "S").Offset(0, -4)

          End If
          
        If Cells(lig, "B") <> Cells(lig + 1, "B") And Cells(lig, "S") = 1 Then
            
                      Rows(lig + 1).Resize(Cells(lig, "Q")).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                   
                    Cells(lig + 1, 2).Resize(Cells(lig, "Q"), 1) = Cells(lig, "B")
                    Cells(lig + 1, 5).Resize(Cells(lig, "Q"), 1) = Cells(lig, "E")
                    Cells(lig + 1, 7).Resize(Cells(lig, "Q"), 1) = Cells(lig, "O")
                    Cells(lig + 1, 11).Resize(Cells(lig, "Q"), 1) = Cells(lig, "K")
                    Cells(lig + 1, 12).Resize(Cells(lig, "Q"), 1) = Cells(lig, "L")
                    Cells(lig, "S").Offset(Cells(lig, "Q"), -12).Value = Cells(lig, "S").Offset(0, -1)
                    Cells(lig, "S").Offset(0, -12).Value = Cells(lig, "S").Offset(0, -4)
             
        End If
    Next lig
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    
End Sub

Microsoft 365 et Office | Excel | Pour la maison | Windows

Question verrouillée. Cette question a été migrée à partir de la Communauté Support Microsoft. Vous pouvez voter pour indiquer si elle est utile, mais vous ne pouvez pas ajouter de commentaires ou de réponses ni suivre la question.

0 commentaires

11 réponses

Trier par : Le plus utile
Le plus utile Les plus récents Les plus anciens
  1. DanielCo 107.7K Points de réputation
    2021-02-20T14:19:25+00:00

    Sur si peu de lignes, on ne va pas gagner grand chose. Exécute la macro ci-dessous et dis-moi le nombre qui s'affiche en fin de macro.

    Quelle est la dernière colonne du tableau ?

    Quelles sont les formules en E13 et 013 ?

    Sub insererLig3() 'palettes complètes et pas complètes utilisées dans le fichier

    Dim lig As Long, Deb

Deb = Timer

Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual

Application.EnableEvents = False

For lig = Cells(Rows.Count, 2).End(xlUp).Row To 13 Step -1

    If Cells(lig, "B") &lt;&gt; Cells(lig + 1, "B") And Cells(lig, "S") = 2 Then

             Rows(lig + 1).Resize(Cells(lig, "Q") - 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

             Cells(lig + 1, 2).Resize(Cells(lig, "Q") - 1, 1) = Cells(lig, "B")

             Cells(lig + 1, 5).Resize(Cells(lig, "Q") - 1, 1) = Cells(lig, "E")

             Cells(lig + 1, 7).Resize(Cells(lig, "Q") - 1, 1) = Cells(lig, "O")

             Cells(lig + 1, 11).Resize(Cells(lig, "Q") - 1, 1) = Cells(lig, "K")

             Cells(lig + 1, 12).Resize(Cells(lig, "Q") - 1, 1) = Cells(lig, "L")

            Cells(lig, "S").Offset(0, -12).Value = Cells(lig, "S").Offset(0, -4)

      End If

    If Cells(lig, "B") &lt;&gt; Cells(lig + 1, "B") And Cells(lig, "S") = 1 Then

                  Rows(lig + 1).Resize(Cells(lig, "Q")).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

                Cells(lig + 1, 2).Resize(Cells(lig, "Q"), 1) = Cells(lig, "B")

                Cells(lig + 1, 5).Resize(Cells(lig, "Q"), 1) = Cells(lig, "E")

                Cells(lig + 1, 7).Resize(Cells(lig, "Q"), 1) = Cells(lig, "O")

                Cells(lig + 1, 11).Resize(Cells(lig, "Q"), 1) = Cells(lig, "K")

                Cells(lig + 1, 12).Resize(Cells(lig, "Q"), 1) = Cells(lig, "L")

                Cells(lig, "S").Offset(Cells(lig, "Q"), -12).Value = Cells(lig, "S").Offset(0, -1)

                Cells(lig, "S").Offset(0, -12).Value = Cells(lig, "S").Offset(0, -4)

    End If

Next lig

Application.ScreenUpdating = True

Application.EnableEvents = True

Application.Calculation = xlCalculationAutomatic

MsgBox Timer - Deb

    End Sub

    Daniel

    Cette réponse a-t-elle été utile ?

    0 commentaires
  2. Anonyme
    2021-02-20T14:09:23+00:00

    B = valeur en "dur"

    K =valeur en "dur"

    E= formule recherche V

    L= valeur en "dur"

    O = rechercheV

    Merci

    Cette réponse a-t-elle été utile ?

    0 commentaires
  3. DanielCo 107.7K Points de réputation
    2021-02-20T14:02:09+00:00

    Que contiennent les cellules des colonnes B, K, E, L et O ? Des formules ? Si oui, lesquelles ?

    Daniel

    Cette réponse a-t-elle été utile ?

    0 commentaires
  4. Anonyme
    2021-02-20T14:00:30+00:00

    Bonjour,

    Le tableau va de la ligne B13 (avec lignes de titre) à S133.

    Merci de ton aide.

    Sandra

    Cette réponse a-t-elle été utile ?

    0 commentaires
  5. DanielCo 107.7K Points de réputation
    2021-02-20T13:43:40+00:00

    Bonjour,

    Quel est, approximativement le nombre de lignes du tableau ? Quelles est la dernière colonne du tableau ?

    Cordialement.

    Daniel

    Cette réponse a-t-elle été utile ?

    0 commentaires