Optimisation traitement vba

**ninette24** · 27/09/2013, 16h46

Bonjour :

Je souhaite optimiser au maximum le temps du traitement (actuellement presque 20 secondes) de code :

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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
 
  base = Sheets("Menu").Range("BA20").Value
        Workbooks.Open base
 
        Windows("suivi.xlsm").Activate
        Sheets("extraction").Select
 
 
Windows("Commentaires.xlsx").Activate
 
DoEvents
 
With Sheets("comments")
        dern = .Range("A65536").End(xlUp).row
        Set plage = .Range(Cells(2, 1), Cells(dern, 1))
 
For Each cell In plage
 
    commentaire = cell.Offset(0, 2).Value
    acteur = cell.Offset(0, 3).Value
    date_de_fin = cell.Offset(0, 4).Value
 
        Select Case commentaire
        Case Is <> ""
            ref = cell.Value
            With Workbooks("suivi.xlsm").Sheets("extraction")
            Set C = .Range("A:A").Find(ref, LookIn:=xlValues)
                If Not C Is Nothing Then
                C.Offset(0, 91).Value = commentaire
                C.Offset(0, 92).Value = acteur
                C.Offset(0, 93).Value = date_de_fin
                End If
            End With
        End Select
 
Next cell
End With
 
 Workbooks("Commentaires.xlsx").Activate
 ActiveWorkbook.Close
 
         Windows("suivi.xlsm").Activate
        Sheets("extraction").Select
 
 
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

Merci pour votre aide

**EngueEngue** · 27/09/2013, 16h53

Premièrement:

Application.screenupdating=false

Deuxièmement: au lieu d'utiliser des ranges: mets tes ranges dans des tableaux.. Tu construis donc trois tableaux:
commentaire()
acteur()
date_de_fin()

Une affectation pour toute tes lignes.

Puis après en bouclant sur ton tableau commentaire de ubound à ubound.
Tu mets un if commentaire =""

Et tu remplis un quatrième tableau à trois dimensions

Puis tu le mets dans le range.

Tu devrais bien gagner 10 secondes

**ninette24** · 27/09/2013, 16h55

Application.screenupdating = false est inclus

Par contre je sais pas du tout comment monter ce tableau

**EngueEngue** · 27/09/2013, 16h58

Code :

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

1
2
Dim commentaire()
commentaire = Sheets("comments").Range("C2:C" & dern).Value

**EngueEngue** · 27/09/2013, 17h07

Il n'y a qu'en pataugeant qu'on apprend. Je ne te rendrais aucun service en te filant un code tout craché. Si tu as été capable de pondre ce code tu peux très bien le faire en passant par des tableaux et ça t'apprendra à faire des codes qui iront plus vite

Si tu n'y es pas parvenu lundi et que tu montres avoir essayé je t'aiderai!

Bon WE!

**ninette24** · 27/09/2013, 17h32

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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
 
'ouverture du fichier sur le serveur
        base = Sheets("Menu").Range("BA20").Value
        Workbooks.Open base
 
        Windows("suivi.xlsm").Activate
        Sheets("extraction").Select
 
 
Windows("Commentaires.xlsx").Activate
 
DoEvents
 
With Sheets("comments")
        dern = .Range("A65536").End(xlUp).row
 
     commentaire = .Range("C2:C" & dern).Value
     acteur = .Range("D2:D" & dern).Value
     date_de_fin = .Range("E2:E" & dern).Value
      ref = .Range("A2:A" & dern).Value
 
    l = Range("A2:A" & [A65000].End(xlUp).row)
 
        For i = LBound(l) + 1 To UBound(l)
        Select Case commentaire
        Case Is <> ""
            With Workbooks("suivi.xlsm").Sheets("extraction")
            Set C = .Range("A:A").Find(ref, LookIn:=xlValues)
                If Not C Is Nothing Then
                C.Offset(0, 91).Value = commentaire
                C.Offset(0, 92).Value = acteur
                C.Offset(0, 93).Value = date_de_fin
                End If
            End With
        End Select
    Next i
 
End With
 
 Workbooks("Commentaires.xlsx").Activate
 ActiveWorkbook.Close
 
         Windows("suivi.xlsm").Activate
        Sheets("extraction").Select
 
'Application.ScreenUpdating = True
'Application.Calculation = xlCalculationAutomatic

J'ai essayé ta solution, mais il me renvoi une erreur.
Je pense qu'il ya un souci

J'ai réussi à monter le tableau

Cependant j'ai toujours plus de 20 secondes de traitement.....

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
With Sheets("comments")
        dern = .Range("A65536").End(xlUp).row
 
    Arr_commentaire = Range("A2:E" & dern)
 
    For R = 1 To UBound(Arr_commentaire, 1) ' First array dimension is rows.
    Select Case Arr_commentaire(R, 3)
    Case Is <> ""
            With Workbooks("suivi.xlsm").Sheets("extraction")
            Set C = .Range("A:A").Find(Arr_commentaire(R, 1), LookIn:=xlValues)
                If Not C Is Nothing Then
                C.Offset(0, 91).Value = Arr_commentaire(R, 3)
                C.Offset(0, 92).Value = Arr_commentaire(R, 4)
                C.Offset(0, 93).Value = Arr_commentaire(R, 5)
                End If
            End With
        End Select
    Next R
 
End With

**patricktoulon** · 27/09/2013, 18h26

Bonjour

sa dure encore 20 ... parceque tu a fait le travail a moitié

tes comment tu les prend dans un tableau que tu crée avec le 1 er classeur
pourquoi ne cré tu pas un 2 eme tableau plutot que de boucle dans le 2 eme classeur

ensuite tu instruit 1 3 eme tableau que tu collera directement dans le sheet avec application transpose

**Didier Gonard** · 27/09/2013, 19h14

Bonjour,

Au niveaux compréhension des Array, tu peux consulter les tutos de DVP

IX. Optimisation du code avec les variables tableau sous Excel

Il y a un exemple ou l'on passe de 1h17mn à 1mn41 secondes sur un traitement de 14 millions de cellules... et un lien vers un autre tuto pour savoir utiliser les instructions relatives aux tableaux.

cordialement,

Didier

**ninette24** · 30/09/2013, 10h05

Bonjour,

J'ai essayé cette solution, mais je elle ne renvoi pas le résultat de la recherche V

quelquun peux m'aider? Merci

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
 With Sheets("comments")
        dern = .Range("A65536").End(xlUp).row
 
    Arr_commentaire = Range("A2:E" & dern)
 
    dern1 = Workbooks("suivi.xlsm").Sheets("extraction").Range("A65536").End(xlUp).row
 
    Arr_comment = Workbooks("suivi.xlsm").Sheets("extraction").Range("A2:CP" & dern1)
 
    For r = 1 To UBound(Arr_commentaire, 1) ' First array dimension is rows.
    Select Case Arr_commentaire(r, 3)
    Case Is <> ""
 
    For rr = 1 To UBound(Arr_comment, 1)
    If Arr_comment(rr, 1) = Arr_commentaire(r, 1) Then
 
                Arr_comment(rr, 92) = Arr_commentaire(r, 3)
                Arr_comment(rr, 93) = Arr_commentaire(r, 4)
                Arr_comment(rr, 94) = Arr_commentaire(r, 5)
 
    End If
    Next rr
    End Select
    Next r
 
End With

**casefayere** · 30/09/2013, 10h30

Bonjour à tou(te)s, ninette24,
Sans avoir étudier ton code (et surtout le dimensionnement de tes tableaux),
Insères au moins le résultat du tableau "Arr_comment" dans un Range
Quelque chose comme ça (à l'aveugle)

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
Sub TTT()
Dim Arr_commentaire, dern As Long, r As Long, rr As Long
With Sheets("comments")
  dern = .Range("A" & .Rows.Count).End(xlUp).Row
  Arr_commentaire = .Range("A2:E" & dern)
End With
With Workbooks("suivi.xlsm").Sheets("extraction")
  dern = .Range("A" & .Rows.Count).End(xlUp).Row
  Arr_comment = .Range("A2:CP" & dern)
  For r = 1 To UBound(Arr_commentaire, 1)
    If Arr_commentaire(r, 3) <> "" Then
      For rr = 1 To UBound(Arr_comment, 1)
        If Arr_comment(rr, 1) = Arr_commentaire(r, 1) Then
          Arr_comment(rr, 92) = Arr_commentaire(r, 3)
          Arr_comment(rr, 93) = Arr_commentaire(r, 4)
          Arr_comment(rr, 94) = Arr_commentaire(r, 5)
        End If
      Next rr
    End If
  Next r
  .Range("A2").Resize(UBound(Arr_comment, 1), UBound(Arr_comment, 2)) = Arr_comment
End With
End Sub

Optimisation traitement vba

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager