Optimisation Macro VBA

Version imprimable

Bonjour à tous, je souhaite optimiser un code VBA qui ajoute des données et met à jour le fichier excel à partir d'un autre fichier excel extrait d'un logiciel.

J'ai optimisé comme j'ai pu certaines fonctions mais ces deux suivantes me mènent la vie dure..

La fonction add() qui va chercher les nouvelles données dans le fichier extract pour les ajouter.

Code:

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
Sub add()
 
Dim a, c, i, j, iRC, k, y As Boolean
Dim WbC As Workbook
 
Set WbC = ThisWorkbook
c = WbC.Sheets("Incidents").Range("A1").CurrentRegion.Value
iRC = UBound(c) + 1
Workbooks.Open Filename:= _
    "fichierextract.xls"
a = ActiveWorkbook.Sheets("DATA").Range("A1").CurrentRegion.Value
ActiveWorkbook.Close
With WbC.Sheets("Incidents")
 For i = 2 To UBound(a)
   For j = 2 To UBound(c)
            If c(j, 5) = a(i, 5) Then
                y = True
            End If
        Next j
         If Not y Then
             For k = 1 To 17
             Cells(iRC, k) = a(i, k)
             Next
                iRC = iRC + 1
          End If
          y = False
    Next i
End With
'MsgBox "L'ajout des nouveaux incidents est terminé !"
End Sub

La fonction update() qui va vérifier que tout soit a jour.

Code:

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
Sub update()
Application.ScreenUpdating = False
LISTE = ActiveWorkbook.Name
Workbooks.Open Filename:= _
            "fichierextract.xls"   ' Le chemin du fichier
IWS = ActiveWorkbook.Name
LastrowC = Workbooks(LISTE).Sheets("Incidents").Cells.Find("*", ActiveSheet.Range("A1"), , , xlByRows, xlPrevious).Row
LastrowI = Workbooks(IWS).Sheets("DATA").Cells.Find("*", ActiveSheet.Range("A1"), , , xlByRows, xlPrevious).Row
 
Dim sheetSource As Worksheet
Dim sheetDest As Worksheet
 
Set sheetSource = Workbooks(IWS).Sheets("DATA")
Set sheetDest = Workbooks(LISTE).Sheets("Incidents")
 
 For i = 2 To LastrowC
        For j = 2 To LastrowI
            If sheetDest.Cells(i, 5) = sheetSource.Cells(j, 5) Then
                        sheetDest.Cells(i, 7) = sheetSource.Cells(j, 7)
                        sheetDest.Cells(i, 9) = sheetSource.Cells(j, 9)
                        sheetDest.Cells(i, 13) = sheetSource.Cells(j, 13)
                        sheetDest.Cells(i, 14) = sheetSource.Cells(j, 14)
                        sheetDest.Cells(i, 15) = sheetSource.Cells(j, 15)
                        sheetDest.Cells(i, 17) = sheetSource.Cells(j, 17)
            End If
        Next j
    Next i
'MsgBox "La mise à jour des données liées aux incidents est terminée !!!!"
Workbooks(IWS).Close False
Application.ScreenUpdating = True
End Sub

Pouvez-vous me donner des pistes sur l'optimisation de ce code , qui peut mettre plusieurs heures s'il y a 20 nouveaux incidents à rajouter et mettre à jour..

Merci d'avance.

14/03/2018, 11h36
a_diard
plutôt que d'écrire cellule par cellule

tu pourrait peur être passer par une variable tableau

et écrire en une seule fois.

il est possible que tu ai des cellules en calcul dans ton fichier

si c'est le cas il faudrait figer les calculs en début de code et réactiver en fin
Code:

1 2 3 4 5 'au début Application.Calculation = xlManual 'a la fin Application.Calculation = xAutomatic
bonne journée
14/03/2018, 11h40
simsimz

Bonjour a_diard et merci de ta réponse.

Etant débutant , pourrais-tu me montrer comment passer par une variable tableau et écrire en une seule fois ?

Merci d'avance :D
14/03/2018, 12h56
halaster08

Bonjour,

Un tuto sur les variables tableaux: http://silkyroad.developpez.com/vba/tableaux/
14/03/2018, 15h21
simsimz

Bonjour halaster08 et merci pour ton lien.

Pourrais-tu me montrer comment appliquer cette technique sur mes fonctions ?

D'avance un grand merci :oops:
14/03/2018, 15h35
halaster08

Citation:

Envoyé par simsimz

Pourrais-tu me montrer comment appliquer cette technique sur mes fonctions ?

Non désolé je ne peux pas faire ton travail à ta place.
As-tu essayé avant de poser de la question ? Qu'est-ce qui te pose problème ?
14/03/2018, 15h56
simsimz

Je ne sais pas par où ni comment m'y prendre.. :oops:

Salut.

Avant de modifier tout ton code que je n'ai pas regardé, tu pourrais ajouter au code proposé par Halaster le fait de geler l'écran durant ta proc
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 Sub...() application.screenupdating = false application.calculation = xlcalculationmanual On Error goto EndHandler ... ... ... EndHandler: Application.calculation=xlcalculationautomatic application.screenupdating=true end Sub

15/03/2018, 08h20
simsimz

Merci Pierre pour cette info :D

Je posterai ici mon nouveau code dès que j'arrive a optimiser le temps d’exécution..