rapidité d'une macro.. comment optimiser

Version imprimable

Bonjour a tous !!

Donc je vous explique mon problème,
j'ai un 1er classeur, (2200 Ko) qui ouvre un 2nd classeur en mode caché quand j'appuie sur un bouton, et fait plein de recherche dedans.(j'ai envieront 14 boutons similaires)
Le deuxième classeur (varie entre 800 Ko et 2400 Ko selon le bouton sur le quel j'appuie) s'ouvre très bien, mais après je ne sais pas ce qui se passe, ma macro met une éternité et dure pendant des heures QUE pour certain classeur (et pas les plus gros)

donc en gros pour un 2em classeur de 2000 Ko ma macro va durée 5min et pour un 2em classeur de 800Ko cela va durée plus de 30min (je coupe au bout d'un moment)

Ma macro est :

Code:

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 Macro_Recherche()
 
         Sheets("Feuill1-classeur1").Select
 
  'Ouverture du fichier de prix (en caché)
        Dim xlApp As Object
        Set xlApp = CreateObject("Excel.Application")
        Dim xlWk As Workbook
        Set xlWk = xlApp.Workbooks.Open(Chemin_dossier & Dossier_sources)
        Dim xlWs As Worksheet
        Set xlWs = xlWk.Worksheets(1)
 
    For i = 11 To 81 Step 5
            Dim rngArticle As Range
            Dim myWs As Worksheet
            Set myWs = ThisWorkbook.ActiveSheet
            DerLig = myWs.Cells(Rows.Count, i).End(xlUp).Row
            Set rngArticle = myWs.Range(myWs.Cells(4, i), myWs.Cells(DerLig, i))
 
            'Recherche de l'article dans l'autre fichier
            Dim rngArticleRecherche As Range
            Set rngArticleRecherche = xlWs.Range(xlWs.Range("A2"), xlWs.Range("A65536").End(xlUp)) 'ICI LA COLONNE RECHERCHE
 
            Dim rngRefTrouve As Range
            Dim cell As Range
 
            For Each cell In rngArticle
                    Set rngRefTrouve = rngArticleRecherche.Find(cell.Value, , xlValues, xlWhole)
 
              If rngRefTrouve Is Nothing Then
            Else
                cell.Offset(, 1).Value = rngRefTrouve.Offset(, 6).Value
 
                    End If
            Next
    Next
 
    'Libération des ressources (fermeture du fichier caché)
    Set xlWs = Nothing
    xlWk.Close (False)
    Set xlWk = Nothing
    xlApp.Quit
    Set xlApp = Nothing
 
    End Sub

je ne sais pas du tout quoi faire ^^'
Merci de m'aider

Cordialement

Essaies comme ceci

Code:

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
Sub Macro_Recherche()
Dim rngArticle As Range, rngArticleRecherche As Range, rngRefTrouve As Range, Cell As Range
Dim xlWs As Worksheet, myWs As Worksheet
Dim xlWk As Workbook
Dim DerLig As Long
Dim i As Integer
 
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
 
Set xlWk = Workbooks.Open(Chemin_Dossier & Dossier_Sources)
Set xlWs = xlWk.Worksheets(1)
 
Set myWs = ThisWorkbook.Worksheets("Feuill1-classeur1")
With myWs
    For i = 11 To 81 Step 5
        DerLig = .Cells(.Rows.Count, i).End(xlUp).Row
        Set rngArticle = .Range(.Cells(4, i), .Cells(DerLig, i))
 
        'Recherche de l'article dans l'autre fichier
        Set rngArticleRecherche = xlWs.Range(xlWs.Range("A2"), xlWs.Cells(.Rows.Count, 1).End(xlUp))    'ICI LA COLONNE RECHERCHE
 
        For Each Cell In rngArticle
            Set rngRefTrouve = rngArticleRecherche.Find(Cell.Value, , xlValues, xlWhole)
            If Not rngRefTrouve Is Nothing Then Cell.Offset(, 1).Value = rngRefTrouve.Offset(, 6).Value
        Next Cell
    Next i
End With
Set myWs = Nothing
Set xlWs = Nothing
xlWk.Close False
Set xlWk = Nothing
MsgBox "Triatement terminé!"
 
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
End Sub

02/04/2014, 15h03
el_slapper

Je pense qu'il y a un problème d'indentation dans ton code, mais ça n'est pas la racine de ton problème.

Par contre application.ScreenUpdating est une petite variable d'environnement qui fait parfois des miracles. Si tu mets application.ScreenUpdating = False au début de ta sub, et application.ScreenUpdating = False à la fin, ça ira plus vite. Ou pas.

Si ça ne suffit pas(souvent, ça suffit, mais tu n'as pas d'insertions de lignes, alors je ne suis pas sur que ça suffise), il faut regarder l'algorithme. Il me semble que la clef du truc, c'est ton find. comme il est systématique, ça finit par faire lourd. Pour aller plus vite, il est parfois nécéssaire de faire des tableaux, voire même de les indexer avec des dictionnaires. Un tutorial sur le sujet. C'est plus performant de travailler sur un tableau que sur un onglet EXCEL comme tu le fais, mais c'est aussi plus compliqué à coder.

(ou alors il y a un truc évident qui m'a échappé. Mais la programmation semble assez propre et standard, indentation mise à part. Je ne suis pas convaincu que tu t'en sortes sans aller dans le compliqué).

EDIT : grillé!!! (et par maitre Mercatog, en plus, je passe pour un rigolo, après, moi...)
02/04/2014, 15h10
mercatog

@el_slapper, bonjour
Loin de là ;)

Ton intervention est pertinente.
02/04/2014, 15h34
sharox

Merci beaucoup d'avoir répondu,

Alors on va commencer par le premier qui m'a répondu ^^
Mercatog.

Donc j'ai copier coller ton code, et encore jamais vue au par avent, mon écran devient tout gris ^^ avec le logo Excel en haut a gauche
J'ai du stopper l'application au bout de 5-10 minutes environ, donc cela n'est pas plus rapide
Par contre mon processeur tourne a fond de balle pour ton code et le mien (90%-75%) ce qui signifie que Excel fait bien quelque chose... mais quoi ^^
Enfin bref les mystère de l'informatique

El_slapper :
La fonction application.ScreenUpdating , je l'ai déjà utilisé et absolument aucun effet... j'ai attendu au moins 5-10 minutes pareils et j'ai stopper

Pour le reste de ton commentaire avec les tableaux et dictionnaires, si je peux éviter d'aller dans le compliquer ^^ je le ferais
Le travail que je fait est un cadeau pourris enfaite et si je peux le quitter le plus vite possible sans me prendre la tête je le ferais

Ensuite je ne comprend pas, le code est le même pour tout les fichier pourquoi pour certain ca marche et pas pour d'autre ?!
Et a cette question je me suis dit ca dois être dans le fichier Excel qu'un truc cloche et je ne trouve pas ce qui cloche -_-

Cordialement
02/04/2014, 17h06
el_slapper

Citation:

Envoyé par sharox

(.../...)Ensuite je ne comprend pas, le code est le même pour tout les fichier pourquoi pour certain ca marche et pas pour d'autre ?!
Et a cette question je me suis dit ca dois être dans le fichier Excel qu'un truc cloche et je ne trouve pas ce qui cloche -_-

Cordialement

Hypothèse : ce n'est pas la taille du fichier qui compte, c'est plus la colonne "A" de ton onglet xlWS. Comme tu passes ta vie à faire des Find là-dedans, si il arrive que c'est particulièrement long, et que ce que tu cherches est toujours à la fin(voir carrément absent), ça explique pourquoi c'est plus long. (mais je ne suis pas sur).

Je n'ai hélas plus avec moi le code de dictionnaire que j'avais codé chez un autre client. C'était un peu laborieux(comparé au code magnifique de Mercatog), mais j'étais passé de 2 heures d'execution à 10 secondes(dont une seule de comparaison indexée des 100 000 éléments avec les 160 000 de référence, le reste, c'était ouvrir les fichiers excel et remplir les tableaux).

Mais avant de savoir si je galèges ou si je brûle, je dois savoir quelle est la taille de cette fameuse colonne ou tu cherches en permanence des trucs. Si elle est colossalle, alors je suis dans le vrai. Sinon, je ne sais pas.
02/04/2014, 18h12
sharox

el-slapper,

enfaite au début j'avais que 2 fichiers
puis étant donné que mon deuxième faisait 20Go et 53 000 lignes / 15 colonnes
Donc je l'ai coupé en 8 morceaux qui font environ entre 6000 et 7000 lignes ( j'ai pris fait pour que ca soit presque la même taille)
(d'ailleurs ca m'a surpris car 20 / 8 = 2.5 et aucun de mes fichier dépasse les 2.4^^)

mais je me demande aussi si c'est pas le fait que à force de rechercher et de rien trouver il s'encrasse pas un peu et ca fini par ramer
Car dans mes deux fichier il doit y avoir entre 0 et 50 références grand max que je recherches.
donc 750 recherches x 6000 lignes = 4 500 000
donc de trouver ca dois lui débloquer le processeur ^^ et c'est pour ca qu'avec les autres ils terminent.

Enfin bref
Merci
Cordialement

J'ajoute un exit for dès que l'article cherché serait trouvé
Code:

1 2 3 4 If Not rngRefTrouve Is Nothing Then Cell.Offset(, 1).Value = rngRefTrouve.Offset(, 6).Value Exit For End If
Sinon au vu du nombre de lignes et la taille des fichiers, je me demande

03/04/2014, 08h23
sharox

a mon avis il faudrait mettre dans la macro soit, quand elle dure plus de 3sec la recherche, elle s'arrête et on passe a la suite
soit / et une macro qui vide le cache a chaque fin de recherche de mot peut être que ca pourrais faire quelque chose non ??

Car j'ai regardé les classeurs, aucunes différences.
Idem pour les codes.

Le problème peux juste venir du fait que dans mes classeurs qui posent problèmes, il n'y a pas beaucoup de recherche aboutissant,
peux être que de coller permet de vider le cache alors que d'enchainer les recherches stock tout dans le cache
(le cache étant le presse papier ou un truc du genre pour moi, quelque chose qui monopolise la RAM)

Ceci ne sont que des hypothèses bien sûr

Cordialement et encore merci

Utilisation des variables tableaux et d'un dictionnaire

Code:

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
55
56
Sub Macro_Recherche()
Dim LastLig As Long, DerLig As Long, i As Long
Dim MonDico As Object
Dim myWS As Worksheet
Dim xlWk As Workbook
Dim j As Integer
Dim TbRech, Tb
 
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
 
'Remplissage du tableau de recherche
Set xlWk = Workbooks.Open(Chemin_Dossier & Dossier_Sources)
With xlWk.Worksheets(1)
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    TbRech = .Range("A2:G" & LastLig)
End With
xlWk.Close False
Set xlWk = Nothing
 
'remplissage du dictionnaire
Set MonDico = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(TbRech, 1)
    If Not MonDico.Exists(TbRech(i, 1)) Then MonDico.Add TbRech(i, 1), TbRech(i, 7)
Next i
 
'parcour des différentes colonnes
Set myWS = ThisWorkbook.Worksheets("Feuill1-classeur1")
With myWS
    For j = 11 To 81 Step 5
        DerLig = .Cells(.Rows.Count, j).End(xlUp).Row
        Tb = .Range(.Cells(4, j), .Cells(DerLig, j + 1))
        RECH MonDico, Tb
        .Range(.Cells(4, j), .Cells(DerLig, j + 1)) = Tb
    Next j
End With
Set MonDico = Nothing
Set myWS = Nothing
 
MsgBox "Triatement terminé!"
 
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
End Sub
 
Private Sub RECH(ByVal Dic As Object, ByRef Res)
Dim i As Long
 
For i = 1 To UBound(Res, 1)
    If Dic.Exists(Res(i, 1)) Then Res(i, 2) = Dic(Res(i, 1))
Next i
End Sub

03/04/2014, 15h51
sharox

Merci beaucoup pour ce code, mais pourrais-tu m'expliquer en gros ce que tu fais,
Car je suis perdu la, pour moi tu crées un tableau virtuel que tu remplis des valeurs d'un autre tableau

Mais je ne sais pas a quoi sa sert ni comment c'est possible ni pourquoi, enfin je sais rien ^^
en attendant ta réponses je regarde sur le site que el_slapper à mis

Merci

Explication sommaire sur le code

Code:

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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
Sub Macro_Recherche()
Dim LastLig As Long, DerLig As Long, i As Long
Dim MonDico As Object
Dim myWS As Worksheet
Dim xlWk As Workbook
Dim j As Integer
Dim TbRech, Tb
 
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
 
'Remplissage du tableau de recherche
Set xlWk = Workbooks.Open(Chemin_Dossier & Dossier_Sources)
With xlWk.Worksheets(1)
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    'On met dans la variable tableau TbRech les données de la plage A:G
    TbRech = .Range("A2:G" & LastLig)
End With
'on ferme le classeur
xlWk.Close False
Set xlWk = Nothing
 
'On crée un dictionnaire qui à une clé unique pour chaque article et un item
Set MonDico = CreateObject("Scripting.Dictionary")
'on parcour le tableau TbRech
For i = 1 To UBound(TbRech, 1)
    'Si TbRech(i,1) n'existe pas encore comme clé du dico, on ajoute la clé (colonne 1) et on lui affecte la colonne G comme item correspondant
    If Not MonDico.Exists(TbRech(i, 1)) Then MonDico.Add TbRech(i, 1), TbRech(i, 7)
Next i
 
'parcour des différentes colonnes
Set myWS = ThisWorkbook.Worksheets("Feuill1-classeur1")
With myWS
    'on parcour les colonnes de Feuill1-classeur1
    For j = 11 To 81 Step 5
        DerLig = .Cells(.Rows.Count, j).End(xlUp).Row
        'on remplit dans Tb pour chaque colonne j les 2 colonnes j et j+1
        Tb = .Range(.Cells(4, j), .Cells(DerLig, j + 1))
        'on traite Tb à l'aide de la sous procédure expliqué ci-dessus
        RECH MonDico, Tb
        'on récrit le nouveau tableau Tb dans la plage
        .Range(.Cells(4, j), .Cells(DerLig, j + 1)) = Tb
    Next j
End With
Set MonDico = Nothing
Set myWS = Nothing
 
MsgBox "Triatement terminé!"
 
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
End Sub
 
'Sous procédure qui permet de verifier l'existence de chaque élément
'd'un tableau Res dans les clés du dictionnaire Dic, si oui remplir la 2nd colonne de Res
'par l'item correspondant à la clé trouvée
'Res est déclaré ByRef => informe toi sur la différence entre byval et byref
Private Sub RECH(ByVal Dic As Object, ByRef Res)
Dim i As Long
 
For i = 1 To UBound(Res, 1)
    If Dic.Exists(Res(i, 1)) Then Res(i, 2) = Dic(Res(i, 1))
Next i
End Sub

Sinon, si tu as au moins testé.

Si tu as des questions précises, le forum est là

03/04/2014, 17h51
sharox

D'accord Merci beaucoup pour ton aide!
C'est très généreux !!
04/04/2014, 21h27
parmi

Est-ce que tu utilises des mises en forme conditionnelles ?
Et lorsque tu déplaces les barres de défilement, est-ce que tu dépasses les zones de données ?
07/04/2014, 10h55
sharox

Alors pour les Mises en Formes conditionnelle, je vient de vérifier et oui j'en utilise sur les deux fichier qui me bloquais..
Est-du a cela ??

Et pour les zones de données, j'ai pas trop compris mais si c'est le fait que en utilisant les barres de défilement je descend jusqu'à la 65536ème lignes,
Non ce n'est pas le cas , j'ai fait un Ctrl + Maj + flèche du bas, et ensuite supprimer.

Mercatog,
Je ne comprend pas trop ton programme,
Enfin surtout un points, j'ai voulu modifier ton programme pour pouvoir l'utiliser dans d'autres fichier, mais il y a un "IK"

Moi dans mon programme j'ai mis :

Code:

cell.Offset(, 1).Value = rngRefTrouve.Offset(, 6).Value

Qui colle 1 cellule à droite après la REF que je cherchais, le résultat que j'ai trouvé dans la 6em cellule après la REF que je cherchais

Sauf que dans ton code je ne vois pas ce "6" et donc je ne comprend pas comment il peux chercher le prix, si je veux changer de colonne en gros je fait comment ??

Cordialement
07/04/2014, 13h10
mercatog
J'ai utilisé 2 variables tableau TbRech et Tb et un dictionnaire MonDico

1. TbRech est un tableau à 7 colonnes (A2:Gxx), on l'aliment à partir de la feuille 1 du fichier qu'on ouvre. C'est à partir de ce tableau qu'on va alimenter notre dictionnaire.
TbRech(1,1) correspond à A2 et TbRech(14,7) correspond à G15 (On a commencé à partir de la ligne 2 de la feuille)

2. Tb est un tableau à 2 colonnes 11 et 12, ensuite 16 et 17 ...enfin 81 et 82.
Dans la première colonne on à les REF et en seconde colonne on va retrouver la valeur correspondante à partir de MonDico.

3. MonDico est un dictionnaire qui va être alimenté à partir de TbRech avec comme clé les valeurs sans doublons de la colonne 1 (colonne A de la feuille) et comme item la valeur correspondante de la colonne 7 (colonne G de la feuille)

Ainsi si on a en A2 de la feuille du classeur de recherche "Toto" et en G2 "BipBip". TbRech(1,1)="Toto" et TbRech(1,7)="BipBip"
le dictionnaire aura une clé "Toto" et l'item correspondant "BipBip"
C'est à dire MonDico("Toto")="BipBip"

L'alimentation du dictionnaire se fait à l'aide de la ligne
Code:

1 2 If Not MonDico.Exists(TbRech(i, 1)) Then MonDico.Add TbRech(i, 1), TbRech(i, 7) 'On ajoute une clé TbRech(i,1) et on lui fait correspondre un item TbRech(i,7)
La procédure Private Sub RECH permet de parcourir les valeurs de la première colonne du Tableau Tb et de voir si ces valeurs sont des clés de MonDico, si c'est le cas elle affecte la valeur de l'item à la seconde colonne.

Voilà, avant d'adapter quoique ce soit, fais un débogage ligne par ligne pour des fichiers petit pour voir le déroulement.