Procedure trop longue

Version imprimable

Bonjour a tous!

Je souhaiterai comprendre pourquoi ce petit bout de code met aussi longtemps a s'executer et du coup l'ameliorer si possible!
Il faut savoir que je mets dans la colonne A environ 11000 dates (que je copie/colle d'un autre fichier generalement)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
 
Dim LastLine As Long
LastLine = Range("a65536").End(xlUp).Row
 
For i = 6 To LastLine
    If Not Application.Intersect(Target, Cells(i, 1)) Is Nothing Then
        Cells(i, 2).Value = Year(Cells(i, 1).Value)
        Cells(i, 3).Value = Month(Cells(i, 1).Value)
        Cells(i, 4).Value = Day(Cells(i, 1).Value)
    End If
Next i
 
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Merci beaucoup de votre aide!

Si tu ne parcours que les lignes qui ont été modifiées ça devrait être plus rapide:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
 
  Application.EnableEvents = False
 
  Dim C As Range
 
  For Each C In Target.Cells.Rows
    If C.Row > 5 Then
      Cells(C.Row, 2).Value = Year(Cells(C.Row, 1).Value)
      Cells(C.Row, 3).Value = Month(Cells(C.Row, 1).Value)
      Cells(C.Row, 4).Value = Day(Cells(C.Row, 1).Value)
    End If
  Next C
 
  Application.EnableEvents = True
 
End Sub

Et il faut désactiver les événements sinon ton code tourne en boucle.

Bonsoir,

Je n'ai pas du tout testé mais comme tu change les valeurs dans les cellules sur l'évènement "Change", cette proc évènementielle est appelée à chaque fois. Si tu mets "Application.ScreenUpdating = False" ceci va donc accélérer la proc :

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
 
Private Sub Worksheet_Change(ByVal Target As Range)
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
 
    Dim LastLine As Long
 
    LastLine = Range("a65536").End(xlUp).Row
 
    For i = 6 To LastLine
 
        If Not Application.Intersect(Target, Cells(i, 1)) Is Nothing Then
 
            Cells(i, 2).Value = Year(Cells(i, 1).Value)
            Cells(i, 3).Value = Month(Cells(i, 1).Value)
            Cells(i, 4).Value = Day(Cells(i, 1).Value)
 
        End If
 
    Next i
 
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
 
End Sub

Hervé.

12/09/2013, 23h21
Frizz

Merci beaucoup Theze! Je ne connaissais pas cette petite manoeuvre mais je sens qu'elle va pas mal me servir! Ca me convient tout a fait!

PS : je changeais l'integralite des lignes d'un coup vcottineau...
14/09/2013, 09h12
Theze

Bonjour,

Je viens de voir à l'instant que j'ai fais une erreur en faisant le copier/coller, je voulais parler de "Application.EnableEvents = False" et bien évidemment pas de "Application.ScreenUpdating = False"

Hervé.