Discussion :

[Frizz]

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 :

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
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!

[Invité]

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

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
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.

[Theze]

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 :

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
 
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é.

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

[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é.