Discussion :

[alex2]

Bonsoir,

j'ai un code (ci dessous) qui travaille sur 2 onglets comportant beaucoup de ligne.
Le compteur_CBN va jusqu'à 700 lignes
Le compteur_sortir va jusqu'à 6000 lignes

Malgré la variable tableau le code est extrêmement long, pouvez vous m'aider à accélérer ce traitement

Merci de votre aide

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
Sub Sorties_9_semaines_avec_if_tableau()
    Dim Compteur_CBN As Integer
    Dim Nb_Lg_CBN As Integer
    Dim Nb_Lg_CBN_Calcul As Integer
    Dim Ref_CBN As String
    Dim Compteur_Sortie As Integer
    Dim Nb_Lg_Sortie As Integer
    Dim Ref_Sortie As String
    Dim Compteur_Sem As Integer
    Dim No_Sem_CBN As String
    Dim No_Sem_Sortie As String
    Dim Nb_Lg_Tablo As Integer
    Dim Somme_Qte As Long
    Dim Tablo_Qte_Sortie As Variant
    '*********************************************
    With Sheets("CBN")
        Nb_Lg_Sortie = Sheets("Rq Sorties").Range("A" & Rows.Count).End(xlUp).Row
        Nb_Lg_CBN = .Range("C" & Rows.Count).End(xlUp).Row
        Nb_Lg_CBN_Calcul = .Range("Q" & Rows.Count).End(xlUp).Row
        If Nb_Lg_CBN_Calcul > Nb_Lg_CBN Then
            .Range("Q7:Y" & Nb_Lg_CBN_Calcul).ClearContents
        Else
            .Range("Q7:Y" & Nb_Lg_CBN).ClearContents
        End If
        '**********************************************
        Nb_Lg_Tablo = Nb_Lg_CBN - 6
        ReDim Tablo_Qte_Sortie(1 To Nb_Lg_CBN - 6, 1 To 9)
        For Compteur_Sem = 1 To 9
            No_Sem_CBN = .Cells(6, Compteur_Sem + 16).Value
            For Compteur_CBN = 7 To 10    'Nb_Lg_CBN
                Somme_Qte = 0
                Ref_CBN = .Range("C" & Compteur_CBN).Value
                For Compteur_Sortie = 2 To Nb_Lg_Sortie
                    Ref_Sortie = Sheets("Rq Sorties").Range("A" & Compteur_Sortie).Value
                    No_Sem_Sortie = Sheets("Rq Sorties").Range("H" & Compteur_Sortie).Value
                    If Ref_Sortie = Ref_CBN And No_Sem_Sortie = No_Sem_CBN Then
                        Somme_Qte = Somme_Qte + Sheets("Rq Sorties").Cells(Compteur_Sortie, 4)
                    End If
                Next Compteur_Sortie
                Tablo_Qte_Sortie(Compteur_CBN - 6, Compteur_Sem) = Somme_Qte
            Next Compteur_CBN
        Next Compteur_Sem
        .Range("Q7").Resize(UBound(Tablo_Qte_Sortie), UBound(Tablo_Qte_Sortie, 2)) = Tablo_Qte_Sortie
    End With
End Sub

[Philippe Tulliez]

Bonjour,
Pour accélérer la vitesse d'exécution d'une procédure qui écrit dans une feuille excel, il y a plusieurs méthodes à ta disposition qu'il faut placer en début de procédure pour l'activer et en fin de procédure pour la désactiver.
L'une d'elle est Application.ScreenUpdating = False qui désactive l'affichage de l'écran.

[mercatog]

Essaies ceci

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
Sub Sorties_9_Semaines_Avec_If_Tableau()
Dim RefCBN As String, RefSortie As String, NoSemCBN As String, NoSemSortie As String
Dim NbLgSortie As Long, NbLgCBN As Long, NbLgCBNCalcul As Long, k As Long, j As Long
Dim Qte As Double, TabloQteSortie() As Double
Dim Sortie, CBN, REF
Dim i As Byte
 
Application.ScreenUpdating = False
With Worksheets("Rq Sorties")
    NbLgSortie = .Range("A" & .Rows.Count).End(xlUp).Row
    Sortie = .Range("A1:H" & NbLgSortie)
End With
 
With Sheets("CBN")
    NbLgCBN = .Range("C" & .Rows.Count).End(xlUp).Row
    If NbLgCBN > 6 Then
        NbLgCBNCalcul = .Range("Q" & .Rows.Count).End(xlUp).Row
        .Range("Q7:Y" & Application.Max(NbLgCBNCalcul, NbLgCBN)).ClearContents
        CBN = .Range("Q6:Y6")
        REF = .Range("C7:C" & NbLgCBN)
        '**********************************************
        NbLgCBN = NbLgCBN - 6
        ReDim TabloQteSortie(1 To NbLgCBN, 1 To 9)
        For i = 1 To 9
            NoSemCBN = CBN(1, i)
            For j = 1 To NbLgCBN
                RefCBN = REF(j, 1)
                For k = 2 To NbLgSortie
                    RefSortie = Sortie(k, 1)
                    NoSemSortie = Sortie(k, 8)
                    If RefSortie = RefCBN And NoSemSortie = NoSemCBN Then Qte = Qte + Sortie(k, 4)
                Next k
                TabloQteSortie(j, i) = Qte
                Qte = 0
            Next j
        Next i
        .Range("Q7").Resize(NbLgCBN, 9) = TabloQteSortie
    End If
End With
End Sub

[alex2]

Merci, je fais des tests et vous dit ce que ça donne
Super, 39 secondes de traitement.

Merci