Bonjour,
J’ai réalisé une macro pour faire de l’analyse de données issues d’un onglet selon certains critères.
Mon soucis est que cette macro marche, par contre je peux mettre selon les cas jusqu’à 8000 lignes à analyser.
Par exemple pour 2000 lignes elle va mettre facile 8mn!
Alors je sais que mon PC est très lent, car je l'ai testée sur un autre et le temps est quand même réduit par 2...
Mais comme c'est moi qui l'utilise, malheureusement la macro est trop longue à tourner.
Je prends les infos sous forme de tableau, je pense que cela me permet d’optimiser le temps.
Mais j’ai l’impression que pas vraiment.
Je vous mets un bout de mon code qui pour moi est l’endroit lent.
Si vous avez le temps et la gentillesse d’y jeter un œil ?
Merci d’avance à vous


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
50
51
52
53
Private Sub RemplissageTab(Feuille, Feuille3, ColonnesMax, TabFeuille, TabFeuille3)
 
Dim i, j, maxligneFeuille As Integer
 
 
maxligneFeuille = Worksheets(Feuille).Range("B" & Worksheets(Feuille).Rows.Count).End(xlUp).Row
 
'''''''''''''''''''''''''''''''''''''''''''''''Définition et remplissage des tableaux à partir des feuilles de départ et d'arrivée
ReDim TabFeuille(maxligneFeuille - 1 - 3, ColonnesMax - 1 + 3 + 1 + 5) 'le tableau commence à 0, on ajoute 3 colonnes au tableau (indicateur, commentaires, couleur, aide à la progra, pour calcul pourcent ok KO Ko AT et sans commentaire(5))
ReDim TabFeuille3(maxligneFeuille - 1 - 3, ColonnesMax - 1 + 3 + 1 + 5)
For i = 0 To UBound(TabFeuille3, 1)
    For j = 0 To UBound(TabFeuille3, 2)
        Set TabFeuille3(i, j) = Worksheets(Feuille3).Cells(4 + i, 1 + j) 'Prend seulement la feuille de données sans la ligne 3 de titres
        Set TabFeuille(i, j) = Worksheets(Feuille).Cells(4 + i, 1 + j) 'Prend seulement la feuille de données sans la ligne 3 de titres
    Next
Next
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
 
End Sub
 
Private Sub RempliFeuilleArrivee(TabFeuille3, TabFeuille, Feuille3)
 
Dim i As Integer
Dim Couleur As String
 
For i = 0 To UBound(TabFeuille, 1)
 
 
    'Rempli la 2eme feuille des nouvelles donnees d'analyse niveau 1
    For j = 0 To 7 - 1
        TabFeuille3(i, j) = TabFeuille(i, j)
    Next j
    For j = 8 - 1 To 22 - 1
        TabFeuille3(i, j + 2) = TabFeuille(i, j)
    Next j
    For j = 25 - 1 To 30 - 1
        TabFeuille3(i, j) = TabFeuille(i, j)
    Next j
 
    TabFeuille3(i, 8 - 1) = TabFeuille(i, 23 - 1) 'OK KO AT...
    TabFeuille3(i, 9 - 1) = TabFeuille(i, 24 - 1) 'message
 
 
    For j = 0 To UBound(TabFeuille3, 2)
        Worksheets(Feuille3).Cells(3 + 1 + i, 1 + j) = TabFeuille3(i, j)
    Next j    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
 
Next i
 
 
End Sub