Problème d'optimisation Copier-Coller VBA

Le 29/07/2015 à 15:44

Bonjour à tous,

J'ai écrit une macro qui récupérer des valeurs dans le tableau "données" pour le coller dans "résultats" en fonction de l'année, mois et semaine.

Le problème c'est que pour un nombre de 25 valeurs "copier-coller" l'opération prend 10 min. J'ai l'impression que ma macro est mal optimisée et que c'est pour cela que ça met tant de temps.

Quelqu'un aurait il une idée?

Sub Remplissage_tableau()
Application.ScreenUpdating = False
Dim i, j As Integer
i = 5
j = 8
    Do While Worksheets("Données").Cells(i, 1) <> ""
        If (Worksheets("Données").Cells(i, 15) = Worksheets("Données").Cells(2, 3) And Worksheets("Données").Cells(i, 16) = Worksheets("Données").Cells(2, 4) And Worksheets("Données").Cells(i, 17) = Worksheets("Données").Cells(2, 5)) Then
        Worksheets("Résultats").Cells(j, 7).Value = Worksheets("Données").Cells(i, 1).Value
        Worksheets("Résultats").Cells(j, 8).Value = Worksheets("Données").Cells(i, 10).Value
        j = j + 1
        End If
    i = i + 1
    Loop

Application.ScreenUpdating = True
End Sub
Le 29/07/2015 à 15:58

Salut,

Je suis pas expert en optimisation mais j'ai plusieurs idées :

  • Mettre un with Worksheets("Données") pour éviter de le redéclarer à chaque fois.
  • Utiliser des variables pour les valeurs qui ne bouge pas du genre : Worksheets("Données").Cells(2, 3)
  • Ne pas faire de Do while (le while est très gourmand en ressource machine) mais plutôt un truc du genre

For i = 5 to Worksheets("Données") .Range("A3500").End(xlUp).Row (Fonction pour récupérer la dernière ligne non vide)

Next i

Déjà tu peux essayer ça.

Cordialement.

Le 29/07/2015 à 16:21

Bonjour

Bonjour Kant1

Peut-être as tu beaucoup de formules

Macro à tester

Sub Remplissage_tableau()
Dim Ligne As Long, J As Long, ModeCalcul As Integer
  With Application
    .ScreenUpdating = False
    ModeCalcul = .Calculation
    .Calculation = xlCalculationManual
  End With

  J = 8
  With Sheets("Données")
    For Ligne = 5 To .Range("A" & Rows.Count).End(xlUp).Row
      If (.Cells(Ligne, 15) = .Cells(2, 3) And .Cells(Ligne, 16) = .Cells(2, 4) And .Cells(Ligne, 17) = .Cells(2, 5)) Then
        Worksheets("Résultats").Cells(J, 7).Value = .Cells(Ligne, 1).Value
        Worksheets("Résultats").Cells(J, 8).Value = .Cells(Ligne, 10).Value
        J = J + 1
      End If
    Next Ligne
    With Application
      .ScreenUpdating = True
      .Calculation = ModeCalcul
    End With
  End With
End Sub
Le 30/07/2015 à 10:10
Kant1 a écrit :

Salut,

Je suis pas expert en optimisation mais j'ai plusieurs idées :

  • Mettre un with Worksheets("Données") pour éviter de le redéclarer à chaque fois.
  • Utiliser des variables pour les valeurs qui ne bouge pas du genre : Worksheets("Données").Cells(2, 3)
  • Ne pas faire de Do while (le while est très gourmand en ressource machine) mais plutôt un truc du genre

For i = 5 to Worksheets("Données") .Range("A3500").End(xlUp).Row (Fonction pour récupérer la dernière ligne non vide)

Next i

Déjà tu peux essayer ça.

Cordialement.

Bonjour,

Merci d'essayer de m'aider, j'ai essayer vos solutions mais j'ai l'impression que le "while" est aussi rapide que le for. Du coup je l'ai remplacé par un do... Loop until.

J'ai pas gagné beaucoup de temps au final. J'ai des formules dans le classeur et des mise en formes conditionnelles.

Est-ce qu'il est préférable de les enlever et de tout faire par macro?

Bonne journée.

Banzai64 a écrit :

Bonjour

Bonjour Kant1

Peut-être as tu beaucoup de formules

Macro à tester

Sub Remplissage_tableau()
Dim Ligne As Long, J As Long, ModeCalcul As Integer
  With Application
    .ScreenUpdating = False
    ModeCalcul = .Calculation
    .Calculation = xlCalculationManual
  End With

  J = 8
  With Sheets("Données")
    For Ligne = 5 To .Range("A" & Rows.Count).End(xlUp).Row
      If (.Cells(Ligne, 15) = .Cells(2, 3) And .Cells(Ligne, 16) = .Cells(2, 4) And .Cells(Ligne, 17) = .Cells(2, 5)) Then
        Worksheets("Résultats").Cells(J, 7).Value = .Cells(Ligne, 1).Value
        Worksheets("Résultats").Cells(J, 8).Value = .Cells(Ligne, 10).Value
        J = J + 1
      End If
    Next Ligne
    With Application
      .ScreenUpdating = True
      .Calculation = ModeCalcul
    End With
  End With
End Sub

Bonjour,

Je viens d'essayer ton code, il marche super bien, ca n'a même pas pris 10s pour faire les calculs. Je vais essayer de comprendre ce que tu as changé pour que ça aille si vite.

Encore merci

Le 30/07/2015 à 10:17

Bonjour,

Si tu as plein de formule qui font des mise à jour ça peut venir de là.

Si tu n'as pas besoin qu'elles se mettent à jour pendant ta macro utilise ça :

'a placer au début pour désactiver les fonctions
Application.Calculation = xlCalculationManual

' 'a placer à la fin pour réactiver les fonctions
Application.Calculation = xlCalculationAutomatic
Rechercher des sujets similaires à "probleme optimisation copier coller vba"