Discussion :

[simsimz]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

[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 :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
'au début
Application.Calculation = xlManual
 
'a la fin
Application.Calculation = xAutomatic

bonne journée

[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

[halaster08]

Bonjour,

Un tuto sur les variables tableaux: http://silkyroad.developpez.com/vba/tableaux/

[simsimz]

Bonjour halaster08 et merci pour ton lien.

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

D'avance un grand merci

[halaster08]

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 ?

[simsimz]

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

[Pierre Fauconnier]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[simsimz]

Merci Pierre pour cette info

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