Accélération code vba

[7339simon]

Bonjour à tous,

Ci-joint un fichier sur lequel j'ai travaillé avec l'aide d'un membre d'un autre forum.
Document Cjoint

Le code ci-dessous (en module 5) est très lent (j'ai plus de 6000 lignes à traiter)

Si certains d'entre vous ont une idée pour accélérer ce code je suis preneur.

J'ai lu sur un autre forum :

"le truc, c'est de passer par un tableau. Tu définis toute la zone sur laquelle tu va travailler et tu la mets dans un Range. Tu définis ensuite un Variant et tu mets le Range dedans. Tu travailles sur le Variant, il n'y a plus d'accès à la feuille et ça va 10 fois plus vite. A la fin tu remets le Variant dans le Range d'un seul coup."

Exemple
Dim rg As Range
Dim v as Variant
Set rg = Worksheets("MaFeuille").Range("A1:G10000")
v = rg
'On travaille sur v ...
rg = v

Vous pensez que je peux utiliser cette méthode dans mon code? Je ne la comprends pas trop.

Mon code que j'essaie d'améliorer :

Merci d'avance pour vos conseils.

Sub Actu()
Dim DLig As Long
Dim i As Long
Dim f As Long
Dim ID As Long
Dim Trouve As Object, PlageDeRecherche As Range

Dim sngChrono As Single

sngChrono = Timer

Application.ScreenUpdating = False

Application.DisplayAlerts = False

Set PlageDeRecherche = Sheets("Feuil1").Columns(1)
For f = 2 To Worksheets.Count
  With Sheets(f)
    DLig = .Range("A" & Rows.Count).End(xlUp).Row
    DCol = .Cells(10, Columns.Count).End(xlToLeft).Column
    For i = 11 To DLig
      ID = .Range("A" & i).Value
      Set Trouve = PlageDeRecherche.Find(what:=ID, LookAt:=xlWhole)
      If Not Trouve Is Nothing Then
        therow = Trouve.Row
        .Range(.Cells(i, 17), .Cells(i, DCol)).Copy Destination:=Sheets("Feuil1").Range("Q" & therow)
      Else
      MsgBox ID & " ID Number Not found"
      End If
    Next i
  End With
Next f

Application.ScreenUpdating = True

sngChrono = Timer - sngChrono
MsgBox "Temps d'execution du code en sec : " & CStr(sngChrono)

End Sub

 

[pierrejean]

Re : Accélération code vba

Bonjour simon

Teste ceci:

Sub actu1()
sngChrono = Timer
derl = Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
derc = Sheets("Feuil1").Cells(10, Columns.Count).End(xlToLeft).Column
Tablo1 = Sheets("Feuil1").Range(Sheets("Feuil1").Cells(11, 1), Sheets("Feuil1").Cells(derl, derc))
For f = 2 To Worksheets.Count
derlin = Sheets(f).Range("A" & Rows.Count).End(xlUp).Row
dercol = Sheets(f).Cells(10, Columns.Count).End(xlToLeft).Column
Tablo2 = Sheets(f).Range(Sheets(f).Cells(11, 1), Sheets(f).Cells(derlin, dercol))
For n = LBound(Tablo1, 1) To UBound(Tablo1, 1)
  For m = LBound(Tablo2, 1) To UBound(Tablo2, 1)
    If Tablo1(n, 1) = Tablo2(m, 1) Then
      For p = 17 To dercol
        Tablo1(n, p) = Tablo2(m, p)
      Next
    End If
  Next
Next
Next
Sheets("Feuil1").Range("A11").Resize(UBound(Tablo1, 1), UBound(Tablo1, 2)) = Tablo1
sngChrono = Timer - sngChrono
MsgBox "Temps d'execution du code en sec : " & CStr(sngChrono)
End Sub

NB: chez moi cela donne environ 10 secondes

 

[7339simon]

Re : Accélération code vba

Bonjour PierreJean, Impressionnant cela tourne en 6 sec chez moi soit presque 100 fois plus vite.

Je n'ai jamais utilisé ce type de tableau, je vais me renseigner pour bien comprendre c'est super.

C'est l'une des techniques les plus rapides?

Par contre y'a t il une possibilité de garder la mise en forme (par exemple couleur de cellule?)

Si pas possible c'est pas grave, c'est déjà bien.

Encore merci

 

[pierrejean]

Re : Accélération code vba

Re

Je pense effectivement qu'il s'agit d'une des techniques les plus rapides
Malheureusement je confirme qu'il ne me parait pas possible de respecter les mises en forme

 

[ROGER2327]

Re : Accélération code vba

Bonjour 7339simon , pierrejean.

Re

Je pense effectivement qu'il s'agit d'une des techniques les plus rapides
Malheureusement je confirme qu'il ne me parait pas possible de respecter les mises en forme

D'accord avec vous.

De plus une modification mineure de votre code le rend pratiquement deux fois plus rapide :​

Sub actu2()
Dim sngChrono!, derl&, derc&, f&, n&, m&, p&
Dim Tablo1(), Tablo2()
  sngChrono = Timer
  derl = Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
  derc = Sheets("Feuil1").Cells(10, Columns.Count).End(xlToLeft).Column
  Tablo1 = Sheets("Feuil1").Range(Sheets("Feuil1").Cells(11, 1), Sheets("Feuil1").Cells(derl, derc)).Value
  For f = 2 To Worksheets.Count
    derlin = Sheets(f).Range("A" & Rows.Count).End(xlUp).Row
    dercol = Sheets(f).Cells(10, Columns.Count).End(xlToLeft).Column
    Tablo2 = Sheets(f).Range(Sheets(f).Cells(11, 1), Sheets(f).Cells(derlin, dercol)).Value
    For n = LBound(Tablo1, 1) To UBound(Tablo1, 1)
      For m = LBound(Tablo2, 1) To UBound(Tablo2, 1)
        If Tablo1(n, 1) = Tablo2(m, 1) Then
          For p = 17 To dercol
            Tablo1(n, p) = Tablo2(m, p)
          Next
        End If
      Next
    Next
  Next
  Sheets("Feuil1").Range("A11").Resize(UBound(Tablo1, 1), UBound(Tablo1, 2)).Value = Tablo1
  sngChrono = Timer - sngChrono
  MsgBox "Temps d'execution du code en sec : " & CStr(sngChrono)
End Sub

Chez moi, 3,4 s au lieu de 6,4.​

Bonne journée.


ℝOGER2327
#7930

Jeudi 5 Gidouille 142 (Saint Ugolin, mansuet - fête Suprême Quarte)
1[SUP]er[/SUP] Messidor An CCXXIII, 5,7295h - seigle
2015-W25-5T13:45:03Z

 

[pierrejean]

Re : Accélération code vba

Bonjour ROGER

Merci pour moi et pour 73339simon

Je vais tenter de me souvenir qu'il existe de bonnes raisons a la déclaration des variables
Peut-être rejoindrais-je un jour les tenants de l'option Explicit ,moi qui en déteste les ayatollahs (ceux qui assènent son obligation sans aucun argument a la clef)

 

[ROGER2327]

Re : Accélération code vba

Re...

Bonjour ROGER

Merci pour moi et pour 73339simon

Je vais tenter de me souvenir qu'il existe de bonnes raisons a la déclaration des variables
Peut-être rejoindrais-je un jour les tenants de l'option Explicit ,moi qui en déteste les ayatollahs (ceux qui assènent son obligation sans aucun argument a la clef)

Une fois de plus d'accord avec vous ! Les docteurs de la Loi qui se bornent à répéter des choses parce que le grand Truc, MVP, ou le génial Machin, expert en tout, l'a dit avant eux sont des plaies.

Il n'y a que l'expérience pour nous apprendre ces choses.

Comme Thomas, je ne crois que ce que je vois. S'agissant de l'« Affaire de l'Option Explicit», je n'ai rejoint le clan des convaincus qu'après moult expériences portant sur des codes comme celui d'aujourd'hui. Mais je ne m'interdis pas de déroger à la règle chaque fois qu'il y a pas de gain évident de temps.​

Chacun fait, fait, fait, ce qui lui plaît, plaît, plaît...​

Bonne soirée.


ℝOGER2327
#7931

Jeudi 5 Gidouille 142 (Saint Ugolin, mansuet - fête Suprême Quarte)
1[SUP]er[/SUP] Messidor An CCXXIII, 6,5062h - seigle
2015-W25-5T15:36:53Z