Bonjour,
Je viens vous voir car j'ai un problème que je n'arrive pas à résoudre (jusque là rien d'étonnant).
Le contexte :
En fait j'ai deux tableaux de taille plus que respectable (10000 et quelques lignes chacun) référençant des produits. L'un est le fichier source et l'autre est l'état du stock à une date donnée. Il s'agit de détecter si il y a des produits dans le stock du jour qui n'apparaissent pas dans le fichier source et de les ajouter à la fin du fichier source.
Problème :
Ma macro plante lorsque je l'applique à mes tableaux. Elle est excessivement lente.. Pourtant avec des tableaux réduits à 1000 lignes, le calcul se fait correctement. Pourriez vous me dire ce que vous en pensez? Auriez vous des conseils pour l'améliorer? (j'ai 3 jours de pratique sur vba (j'ai fait un peu de java avant) donc mon code est potentiellement très moche)
Merci d'avance!
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
54 Sub ActualiserLQUASource() Application.ScreenUpdating = False 'Actualisation de LQUASource Dim nbrowsrc As Integer nbrowsrc = Sheets("LQUASource").Cells(65536, 4).End(xlUp).Row Dim nbrowday As Integer nbrowday = Sheets("LQUA16072015").Cells(65536, 4).End(xlUp).Row Dim ToAdd() As Boolean ReDim ToAdd(nbrowday) Sheets("LQUASource").Select 'Détection des éléments manquants For i = 2 To nbrowday 'Vérifie que la référence du stock du 16/07/2015 est valable If Len(Sheets("LQUA16072015").Cells(i, 5)) = 10 Then test = 0 For j = 3 To nbrowsrc If Sheets("LQUA16072015").Cells(i, 8) = Sheets("LQUASource").Cells(j, 8) Then test = test + 1 End If Next j If test = 0 Then ToAdd(i) = True Else ToAdd(i) = False End If End If Next i 'Ajout des éléments manquants à la fin du tableau source "LQUASource" For i = 2 To nbrow If ToAdd(i) Then Dim j As Variant For j = 1 To 9 Sheets("LQUASource").Cells(nbrowday + i - k, j) = Sheets("LQUA16072015").Cells(i, j) Next j Else k = k + 1 End If Next i Application.ScreenUpdating = True End Sub
Partager