Discussion :

[zeralium]

Bonjour,

J'ai un probleme de lenteur sur la petite macro suivante

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
Dim a As Integer
        a = 2
        While Not Cells(a, 2) = ""
            If Cells(a, 2) > 0 Then
                Dim B As String
                B = Cells(a, 1)
                Dim c As Integer
                c = 2
                Windows("Test gestion IO.xls").Activate
                Sheets("Temp IO").Select
                    While Not Cells(c, 7) = ""
                          If Cells(c, 7) = B Then
                          Range(Cells(c, 1), Cells(c, 12)).Copy
                          Sheets(B).Range("A2").Insert shift:=xlDown
                          Application.CutCopyMode = False
                          End If
                          c = c + 1
 
                          Sheets("Temp IO").Select
                    Wend
             End If
             a = a + 1
             Windows("Reference.xls").Activate
             Sheets("Liste controller").Select
        Wend

Mon fichier "Temp IO" comprend environ 2300 lignes.

Il existe peut etre un autre code???

[fring]

Bonjour,

Tu peux tester ceci stp

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
Sub test()
Dim WStemp As Worksheet, WSlc As Worksheet
Dim i As Integer, j As Integer, B As String
 
Set WStemp = Workbooks("Test gestion IO.xls").Sheets("Temp IO")
Set WSlc = Workbooks("Reference.xls").Sheets("Liste controller")
 
For i = 2 To WSlc.Cells(Rows.Count, 2).End(xlUp).Row
    If WSlc.Cells(i, 2) > 0 Then
        B = WSlc.Cells(i, 2)
        With WStemp
            For j = 2 To .Cells(Rows.Count, 7).End(xlUp).Row
                If .Cells(j, 7) = B Then
                    .Range(.Cells(j, 1), .Cells(j, 12)).Copy
                    .Sheets(B).Range("A2").Insert shift:=xlDown
                End If
            Next j
        End With
    End If
Next i
 
End Sub

[neupont]

Tu peux aussi désactiver certaines fonctions avant le 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
 
Application.EnableCancelKey = xlDisabled
Application.ScreenUpdating = false
Application.DisplayAlerts = false
Application.Interactive = false
Application.Calculation = xlCalculationManual
 
... ton traitement...
 
Et les réactiver après le traitement :
Application.ScreenUpdating = true
Application.DisplayAlerts = true
Application.Interactive = true
Application.Calculation = xlCalculationAutomatic

Surtout efficace s'il y a beaucoup d'écritures dans le classeur, moins si ce n'est que de la consultation.

[zeralium]

Merci pour votre aide, mais le gain de temps n'etait pas flagrant. J'ai opté pour le code suivant:

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
Dim B As String, a As Integer
    a = 2
    Sheets("parametres").Select
    B = Cells(a, 1)
 
 
    While Not Cells(a, 1) = ""
        If Cells(a, 1) > 0 Then
            B = Cells(a, 1)
            Sheets("Temp IO").Select
            Selection.AutoFilter Field:=7, Criteria1:=B
            Range("A2").Select
            Range(Selection, Selection.End(xlToRight)).Select
            Range(Selection, Selection.End(xlDown)).Select
            Selection.Copy
            Windows("Test gestion IO.xls").Activate
            Sheets(B).Select
            Range("A2").Select
            ActiveSheet.Paste
            Application.CutCopyMode = False
        End If
        a = a + 1
        Sheets("parametres").Select
    Wend

Avec ce code je passe de 10 min a moins d'une minute.