Discussion :

[dede_bo]

Bonjour à toutes et tous

J'ai un sérieux souci de performance avec un fichier XL sous Excel 2016 uniquement.

Je possède un fichier ayant 6000 ligne et 35 colonnes. Soit pas grand chose. Certains de ces fichiers peuvent contenir jusque 60.000 lignes.

La macro doit contrôler, pour chaque cellule, si les valeurs sont correctement introduite en fonction de différents paramètres.
Si ce n'est pas le cas, le système doit mettre le fond de la cellule concernée en rouge.
Un popup est affiché et montre les lignes et colonnes en erreur.

Pour toutes les versions d'Excel (2007, 2010 et 2013), le résultat est extrêmement rapide. Comme vous pouvez le voir sur cette vidéo.

Pour info, avec les deux vidéos, je vous montre la vitesse d'exécution pour les 10 premières lignes du document.

Vidéo pour Excel 2010: C'est instantané

Par contre, sous Excel 2016, c'est la catastrophe.
Vidéo pour Excel 2016:

Il n'y a pas photo.

Pour les 6000 lignes, Excel crash. Imaginez pour 60.000 lignes!
Une fois crashé, je dois attendre ± 15min pour que s'ouvre le fichier.

J'ai déjà regardé sur le forum et j'ai mis en pratique les différentes idées de chacun d'entre vous. Sans succès.
Cela me donne l'impression que l'instruction "ScreenUpdating" n'est pas exécuté.

En début de code, j'ai mis les instructions suivante:

Code :

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

1
2
3
4
 
' Augmentation des performances    
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Ce que j'aimerais savoir s'il y a des différences avec Excel 2016 à ce niveau?
Comment puis-je résoudre ce problème?

Comment fonctionne le système:
J'ai écris une fonction où je passe par paramètre : le n° de ligne et l'objet de la feuille.

Je parcours le fichier ligne par ligne.
J’appelle cette fonction qui me retournera la liste des colonnes en erreur.
La fonction change la couleur de la cellule en erreur.

Si quelqu'un parmi vous aurait quelques idées... Cela serait le bienvenu.
Merci d'avance
André

[patricktoulon]

re
oui c'est pas la premiere fois que l'on vois avec 2016 des lenteurs due a l'acces a la memoire voir a l'acces au object non dispo apres declaration dans VBA

le code serait le bien venu pour voir si on peut améliorer

[dede_bo]

Bonjour,
J'aimerais vous remercier d'avance pour votre réaction ultra rapide.

Par soucis de confidentialité, j'ai retiré certain ligne de code (protection, valeurs particulières)... Mais cela ne gène en rien au fonctionnement.
Je ne peux pas fournir le fichier lui-même (ordre de mon patron).

Code principal

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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
 
Sub CreateDocument()
    DeclareSheet
    Dim rw As Long
    Dim rd As Long
    Dim ct As Long
    Dim cl As Integer
    Dim lstrw As Long
    Dim newfeuille As Worksheet
    Dim zone As String
    Dim texte As String
    Dim message As String
    Dim lgne As Long
    Dim MaxEmpty As Integer
    Dim RwEmpty As Integer
    Dim avancement As Double
    Dim tmp As Long
    Dim pk_check As Boolean
    Dim t As Long
    documentChked = False
 
    ' Calcul le nombre de ligne à traiter
 
    lstrw = 2   ' Ligne des titres
    ct = 1      ' pointeur du tableau d'erreur
 
    ReDim ErrTbl(1)   ' Ce tableau (publique) contiendra la liste des numéros de ligne en erreur (utilisé dans une autre macro)
 
    ' Ne sachant pas où se trouve la donnée la plus basse dans le fichier, je dois parcourir chaque colonne (à l'exception de la primary key).
    ' Et je calcule le n° de ligne le plus bas. Je ne peux pas utiliser l'instruction :  Range(Cel).CurrentRegion.End(xlDown).Row
    ' Car cette primary key descend beaucoup plus bas que les données elles-même.
 
    For cl = 3 To 38
        tmp = LstRows(feuille, ColumnLetter(cl))
        If tmp > lstrw Then
            lstrw = tmp
        End If
    Next cl
 
    ' Ce contrôle est pour voir si le fichier est vide ou non (juste les titres)
    If lstrw = 2 Then
        MsgBox "The template is empty. Nothing to do", vbInformation + vbOKOnly, "Remark"
        fg = True
        Exit Sub
    End If
 
    MaxRw = lstrw   ' Sauve le nombre de ligne. Utilisé lors de la génération du nouveau document (dans une autre macro)
 
    ' Initialise la progress bar
 
    Progress_Status.ProgressBar.Width = 10
    Progress_Status.ProgressBar.Visible = True
 
    Progress_Status.StatusMessage.Clear
 
    Progress_Status.lbl_Progress = "0%  Row: 3 on " & lstrw
    Progress_Status.Bt_Close.Visible = False
    Progress_Status.Repaint
 
    ' Evite le "flashing" durant le traitement
 
    DoEvents
    Progress_Status.Show vbModeless
 
    ' Augmentation des performances
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
 
    message = ""
    avancement = 0  ' calcul de la progress bar
    RwEmpty = 0     ' compteur de ligne vide
    MaxEmpty = 10   ' Je considère la fin du document lorsqu'il y a 10 lignes vide consécutive.
 
    For rw = 3 To lstrw
        ' Contrôle la validité des données de la ligne en cours.
        ckx = checkRow(feuille, rw)
        If Len(ckx) > 0 Then
            ' Ajoute la ligne en erreur dans le popup
            Progress_Status.StatusMessage.AddItem "- There is mistake on row: " & rw & " on following column: " & ckx
 
            ' Ajoute le numéro de la ligne en erreur dans un tableau (utilisé dans une autre macro)
            ErrTbl(ct) = rw
            ct = ct + 1
            ReDim Preserve ErrTbl(ct)
 
            If Len(ckx) = 28 Then
                RwEmpty = RwEmpty + 1
                If RwEmpty > MaxEmpty Then
                    Progress_Status.StatusMessage.AddItem "- End of file"
                    Exit For
                End If
            Else
                RwEmpty = 0
            End If
            total = total + 1
        End If
 
        ' Remet à jour la progress bar
 
        avancement = (rw - 2) / (lstrw - 2) ' retire les titres
 
        Progress_Status.lbl_Progress = "Progress: " & Int(avancement * 10000) / 100 & "%  Row: " & rw & " on " & lstrw
        Progress_Status.ProgressBar.Width = (avancement * 360)   ' Affiche une progress bar
        Progress_Status.Repaint
 
    Next rw
 
    documentChked = True
End Sub

Code de la fonction:

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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
Function checkRow(ws As Worksheet, rw As Long) As String
 
    Dim result As String    ' Recevra la liste des colonnes en erreur (lettre de la colonne)
    Dim zone As String
    Dim cel As Range
    Dim contenu As String
 
    result = ""
    cl = 1
    zone = "A" & rw & ":" & ColumnLetter(LstColumn(ws, 2)) & rw
 
    ws.Range(zone).Interior.ColorIndex = xlNone     ' Avant de contrôler la ligne, j'enlève les éventuelles couleur.
 
    chkval = ws.Cells(rw, 1)                                ' primary key (utilisé lors de l'importation dans une base de donnée). Par confidentialité, je ne peux pas en dire plus.
    p = InStr(1, chkval, "//")
 
 
    zone = "B" & rw & ":" & ColumnLetter(LstColumn(ws, 2)) & rw  ' Zone des données sans la primary key
 
    ' Je compte si toutes les cellules contient une valeur. Si c'est le cas, c'est bon. Je sort de la fonction.
 
    If WorksheetFunction.CountA(ws.Range(zone)) = 0 Then
        ws.Cells(rw, 1).Interior.ColorIndex = xlNone
    Else
       ' Je contrôle la validité de la primary key
        If p > 0 Or Right(chkval, 1) = "/" Then
            ws.Cells(rw, 1).Interior.ColorIndex = 40
        Else
            ws.Cells(rw, 1).Interior.ColorIndex = xlNone
        End If
 
        ' Je parcours chaque cellule
 
        For Each cel In ws.Range(zone)
            contenu = CStr(cel.Value)
 
            ' Je recherche, pour certaines cellules, qu'elles soient remplie avec une valeur particulière. 
            ' 
            If contenu = "" Or IsNull(contenu) Then
                If (cel.Column <> 6 And cel.Column <> 7 And cel.Column <> 8 And cel.Column <> 13 And cel.Column <> 16 And cel.Column <> 18 And cel.Column <> 19 And cel.Column <> 20 And cel.Column <> 21 And cel.Column <> 25 And cel.Column <> 27 And cel.Column <> 28 And cel.Column <> 29 And cel.Column <> 31 And cel.Column <> 32 And cel.Column <> 33 And cel.Column <> 34 And cel.Column <> 35 And cel.Column < 38) Then
                    If cel.Column = 23 Then
                        If Left(cel.Offset(0, -9), 7) = "Pending" Then
                            cel.Value = "N/A"
                        End If
                    ElseIf cel.Column = 36 Then
                        If cel.Offset(0, -21) = "Rejected" Then
                            result = result & " AJ,"
                            cel.Interior.ColorIndex = 40
                        End If
                    ElseIf cel.Column = 37 Then
                        If cel.Offset(0, -8) = "YES" Then
                            result = result & " AK,"
                            cel.Interior.ColorIndex = 40
                        End If
                    Else
                        result = result & ColumnLetter(cel.Column) & ","
                        cel.Interior.ColorIndex = 40
                    End If
                End If
            End If
            cl = cl + 1
        Next cel
 
    End If
 
    If Len(result) > 0 Then
        checkRow = Left(result, Len(result) - 1) ' J'enlève la dernière virgule de la liste
    Else
        checkRow = ""
    End If
End Function

Voilà, si cela peux vous aider.
Encore merci
André

[Patrice740]

Bonjour,

Il y a une différence apparue avec Excel 2013, la nouvelle interface SDI, qui m'a dèja posé problème avec ScreenUpdating = False, c'est peut-être une piste.
Voir ce fil : https://www.developpez.net/forums/d1.../#post10631486

Édit : Ton screenupdating ne me semble pas placé au bon endroit

[dede_bo]

Bonjour,
Je viens d'essayer votre idée mais sans succès.

Par contre, ce que j'aimerais faire:
Vu que ce qui prend beaucoup de ressources, c'est de manipuler le graphique.
donc, dans mon esprit, pour chaque erreur trouvée, au lieu de changer la couleur, je remplace par un "flag".
Une fois le contrôle terminé, je remplace la couleur de toutes les cellules ayant ce flag.

Je pense que cela pourrait augmenter les performances.

Mais, comment faire pour sélectionner toutes les cellules "flagées" et remplacer la couleur !

Merci

[Patrice740]

Bonjour,
Je viens d'essayer votre idée mais sans succès.

Je pense qu'il faut placer le screenupdating avant la création du document.

Vu que ce qui prend beaucoup de ressources, c'est de manipuler le graphique.
donc, dans mon esprit, pour chaque erreur trouvée, au lieu de changer la couleur, je remplace par un "flag".
Une fois le contrôle terminé, je remplace la couleur de toutes les cellules ayant ce flag.

Mais, comment faire pour sélectionner toutes les cellules "flagées" et remplacer la couleur !

Merci

If suffit de "mémoriser" toutes les cellules dans un range (avec Union) puis d'appliquer la couleur au Range