Discussion :

[parmi]

Bonjour,

J'essaie d'utiliser Application.VLookUp plutôt que Find pour une longue recherche de quelques 2000 codes dans une liste de 30000 codes.

En utilisant Find, ça prend environ 4 minutes et j'essaie d'accélérer le tout.
J'utilise ScreenUpdating = False et Calculation = xlCalculationManual pour réduire le temps d'exécution au max.

En essayant avec Application.VLookUp, ça semble aller plus vite, mais ça plante après 225 lignes (ou codes) avec le message "Exécution interrompue".
Si je clique sur Continuer, ça continue pour quelques autres lignes puis ça recommence.

Quelqu'un aurait une réponse à ce problème ?
Et éventuellement une solution ?

Merci !

[NVCfrm]

Bonsoir,
n'y aurait-il pas un gestionnaire activé quelque part?

[parmi]

Merci de t'intéresser au cas...

Qu'entends-tu par "gestionnaire" ?

[NVCfrm]

Mille excuses.
Je penses à un gestionnaire d'évènement ou d'erreur.
Si ce n'est pas le cas, peux tu poster le code afin de qu'un ou des regards neufs puissent ...

[parmi]

J'ai aussi essayé avec Application.Match (Equiv) et le résultat est le même... Exécution interrompue...
Et ça arrête toujours à la 218e ligne, donc 218 * 20 itérations = 4360 passages par la fonction VLookUp

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
Sub TestCalculOut()
    Dim I As Long, J As Long, nbLignes As Long, LigneOut As Long
    Dim Cnt As Long, CntMax As Long
    Dim Temps As Double
 
    Temps = Timer
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
    nbLignes = Sheets("SFF").Cells(Rows.Count, "B").End(xlUp).Row
    LigneOut = Sheets("Suivi OUT").Cells(Rows.Count, "B").End(xlUp).Row
 
    Sheets("SFF").Range("AX5:AX" & nbLignes).ClearContents
 
    For I = 5 To nbLignes
        Application.StatusBar = "Lecture de la ligne " & I & " sur " & nbLignes
        Cnt = 0
 
        If IsFrais(Sheets("SFF").Range("E" & I)) Then
            CntMax = 13
        Else
            CntMax = 20
        End If
 
        For J = CntMax To 1 Step -1
            If IsError(Application.VLookup(Sheets("SFF").Range("A" & I) & J, Sheets("Suivi OUT").Range("B2:B" & LigneOut), 1, False)) Then
                Sheets("SFF").Range("AX" & I) = Cnt
                Exit For
            Else
                Cnt = Cnt + 1
            End If
        Next
        If CntMax = Cnt Then Sheets("SFF").Range("AX" & I) = CntMax
    Next
 
    Application.StatusBar = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
 
    MsgBox "Terminé en" & vbCrLf & Timer - Temps & " sec."
End Sub

[parmi]

J'ai finalement résolu le problème.
J'ai rebooté mon PC...

Ça prend donc 40 secondes avec Application.VLookUp plutôt que 4 minutes et plus avec des Find...

[NVCfrm]

Bien j'allais justement te dire d'essayer éventuellement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.EnableCancelKey = xlDisabled

Car le message Exécution interrompue vient d'une commande d'interruption, activée quand et par quoi ?

Edit:
40 s. C'est un temps qui peut être considérablement réduit en passant par d'autres voies.
Je rappelle comme tu as dû le constater: Find est pratique pour des traitements courts moins récursifs. VLook semble pratique, mais reste tout de même lourd pour un traitement massif sous VBA.
Si à défaut d'inspiration autre que les VLook ou CountIf ..., pour des traitements lourds, il vaut mieux construire la formule destinée à une plage du tableur qui fera le calcul instannément.

[parmi]

J'ai bien essayé de brasser les neurones qui me restent, mais je n'ai pas trouvé mieux que ça.

Pour le contexte,
J'ai une colonne de 30000 valeurs, du genre (sans les couleurs...)
1231
1232
1233
2221
2222
22219
22220

Dans une autre feuille, une colonne de 2000 valeurs uniques, du genre
123
222

En partant de 20 jusqu'à 1, je dois trouver le nombre d'occurrences de suite qui existe.
Difficile à expliquer, mais dans l'exemple, j'aurais 2 pour 222 et 0 pour 123

Si tu penses à une autre voie, je suis preneur

[NVCfrm]

Bonsoir,
Je ne suis pas en possession de tous mes moyens. Quelques vertiges. Je me remets d'une convalescence dû au paludisme.
Quelques pistes:
VBA étant interprété, on ne peut compter sur l'optimisation du compilateur.
Construit des variables objets, et des variant qui sont plus rapides d'accès.
Par exemple l'arg 1 de VLook peut être un objet Range défini ainsi:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Dim val_cherche As Range
Dim tab_valeur
Set val_cherche = WorkSheets("SFF").Range("A1")
tab_valeur = Sheets("Suivi OUT").Range("B2:B" & LigneOut)

Dans la boucle :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.VLookup(val_cherche(Val(i & j),1), tab_valeur, 1, False)

Évidemment, je n'ai pas saisi toute la complexité du problème. Je pourrais y penser un peu plus sérieusement en ayant aussi un peu plus de détails pour te proposer du concret.

[parmi]

J'ai enlevé le "Résolu" au cas où.
Je vais tester ta méthode demain au boulot et je reviendrai avec plus de détails, si nécessaire.

Merci et bois de l'eau...
J'ai déjà vécu ces symptômes et je te comprends....

[parmi]

Ce matin, avec une machine un peu plus "fraîche", j'ai essayé avec et sans des variables pour la valeur et la plage et ça ne change rien.
Ça tourne autour de 36-37 secondes dans les 2 cas.

C'est tout de même pas mal mieux que le 4 minutes et demi avec les Find...

Merci tout de même.

[NVCfrm]

Salut,
un peu étonné qu'avec des variants et des objets typés la différence ne soit pas flagrante.
J'ai une ou deux petites idées que je voudrais essayer.
Quel test est effectué dans la fonction IsFrais ?

[parmi]

C'est une function booléenne qui vérifie un code entre 2 limites
Disons entre 6500 et 6700 = Vrai sinon Faux

[NVCfrm]

Salut,

je ne sais pas si l'approche correspond au problème. Essayes cette portion de code pour déterminer si le résultat correspond au code initial:

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
 
Sub TestCalculOut()
    Dim I As Long, J As Long, nbLignes As Long, LigneOut As Long
    Dim Cnt As Long, CntMax As Long
    Dim Temps As Double
 
    Temps = Timer
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
    nbLignes = Sheets("SFF").Cells(Rows.Count, "B").End(xlUp).Row
    LigneOut = Sheets("Suivi OUT").Cells(Rows.Count, "B").End(xlUp).Row
 
    Sheets("SFF").Range("AX5:AX" & nbLignes).ClearContents
 
    Dim frm
    frm = "=COUNTIF(FEUIL2!R1C2:R" & LigneOut & "C2," _
    & "INDEX(FEUIL1!R1C1:R" & nbLignes & "C1," _
    & "VALUE(ROW()&IF(AND(RC5>=6500,RC5<=6700),13,20))))"
    Range("ax5:ax" & nbLignes).FormulaR1C1 = frm
    Range("ax5:ax" & nbLignes).Value = Range("ax5:ax" & nbLignes).Value
 
 
    Application.StatusBar = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
 
    MsgBox "Terminé en" & vbCrLf & Timer - Temps & " sec."
End Sub

[parmi]

Je ne peux faire de tests avant Lundi, mais je te tiens au courant...
Merci pour le suivi.

[eriiic]

Bonjour,

si tu pouvais mettre à disposition un fichier de travail avec les explications complètes et le résultats attendu...
eric

[parmi]

J'en suis rendu à une trentaine de secondes ce qui me paraît tout à fait satisfaisant compte tenu du nombre d'itérations et de la complexité.
Et je ne vois aucune formule capable de le faire...

Pour explication, j'ai mis le résultat de formules en encadré dans SFF.
Les X signifient que les valeurs ont été retrouvées dans Suivi OUT et j'ai laissé les formules sur la 1e ligne pour ne pas allourdir indûment. Les résultats dans le colonne AX sont ceux escomptés, c'est-à-dire le nombre de X trouvés en partant de la droite tant qu'il n'y a pas de vide.

Dans Suivi OUT, ce sont les mêmes codes qu'en colonne A de SFF, avec un numéro de période de 1 à 20 ajouté à la fin.

[NVCfrm]

Bonjour parmi,

Je nages devant la complexité du problème.
Je n'ai sans doute pas compris le pourquoi de beaucoup de choses dans l'approche, ne pouvant appréhender les besoins et contraintes d'une telle complexité.
Peut-être que c'est ce qui a foiré ma machine ?
Tu peux tester le code de ce fichier et me dire ce qu'il en est

Je restes à l'écoute.

[parmi]

Ta dernière méthode met plus de temps.
Et le résultat est inversé.

J'ai finalement opté pour 2 tableaux et j'en suis rendu à 22-23 secondes ce qui m'apparaît comme le plus rapide possible...

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
Sub TestAvecTableaux()
    Dim I As Long, J As Long, Cnt As Long, CntMax As Long
    Dim LignesSFF As Long, LignesOut As Long
    Dim TabloSFF As Variant, TabloOut As Variant
    Dim Temps As Double
 
    Temps = Timer
 
    LignesSFF = Sheets("SFF").Cells(Rows.Count, "A").End(xlUp).Row
    LignesOut = Sheets("Suivi OUT").Cells(Rows.Count, "B").End(xlUp).Row
 
    TabloSFF = Sheets("SFF").Range("A5:A" & LignesSFF).Value
    TabloOut = Sheets("Suivi OUT").Range("B2:B" & LignesOut).Value
 
    For I = 1 To UBound(TabloSFF)
        Cnt = 0
 
        If Sheets("SFF").Range("B" & I + 4) >= 6500 And Sheets("SFF").Range("B" & I + 4) <= 6720 Then
            CntMax = 13
        Else
            CntMax = 20
        End If
 
        For J = CntMax To 1 Step -1
            If IsInTabloOut(TabloSFF(I, 1) & J, TabloOut) Then
                Cnt = Cnt + 1
            Else
                Sheets("SFF").Range("AX" & I + 4) = Cnt
                Exit For
            End If
        Next
    Next
 
    MsgBox "Terminé en" & vbCrLf & Timer - Temps & " sec."
End Sub
 
Function IsInTabloOut(Valeur As String, tablo) As Boolean
    Dim I As Long
 
    For I = UBound(tablo) To 1 Step -1
        If tablo(I, 1) = Valeur Then
            IsInTabloOut = True
            Exit Function
        End If
    Next
End Function

Merci beaucoup de t'être intéressé au problème.