Discussion :

[CaptainMeta]

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 )

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

Merci d'avance!

[Marc-L]

Bonjour,

la lenteur est normale vu le principe répétitif de parcourir le classeur source par boucle !
Et ce genre d'applicatif est plutôt à développer sous Access …

Si volonté d'insister sous Excel, diverses solutions possibles, par exemple :

• utiliser les fonctionnalités d'Excel est bien plus efficace qu'une procédure en pur VBA comme cette boucle répétitive !
Dans le classeur du stock du jour, utiliser la fonction de feuille de calculs EQUIV
afin de trouver le n° de ligne de la référence dans le classeur source.
Cette fonction renvoie une erreur #N/A lorqu'il n'y a pas de correspondance. En la couplant avec la fonction ESTNA,
VRAI indique donc les lignes à copier, en filtrant sur cette condition, reste à copier les lignes filtrées …

Une variante possible copiant directement les données en utilisant ces fonctions dans un critère calculé d'un filtre avancé …

• Charger les références du classeur source dans un objet Dictionary (consultable dans l'aide VBA).
Copier chaque ligne du classeur du jour dont la référence n'existe pas dans le dictionnaire …

_____________________________________________________________________________________________________
Je suis Charlie, Bardo, Sousse

[CaptainMeta]

Bonjour,

Merci beaucoup pour votre solution! C'est parfait pour mon utilisation

Je suis parti un peu comme un boeuf pour faire un code et automatiser tout ça.. Mais ce n'est pas le plus efficace! Mea Culpa, je ne le referais plus