code très lent

Version imprimable

code très lent

Bonjour,

Je suis nouvelle sur ce forum, et j'ai un pb équivalent à celui de cette discussion.

Voici le contexte :
J'ai un code vba dans une base access, qui compare des data d'un fichier excel et de la database, les tries et export le tout dans un fichier excel puis pdf.
J'ai fait plusieurs macros liées les unes aux autres et l'un d'entre elle dure plus d'1 min et un autre 9 min !! Je cherche à optimiser le code afin de réduire ce temps de process.
Pourriez-vous m'aider ?
Ci-dessous quelques infos. Merci d'avance pour votre aide.
Diane

Le bout de code ci-dessous est pour la macro d'1 min: cette macro consiste à chercher les valeurs dans une plage de données de tous les onglets d'un fichier excel (jusqu'à 9 onglets - 2430 valeurs) et les coller dans une colonne dans un autre fichier ("strFilename").

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
    For Each Freezer In ActiveWorkbook.Worksheets
        Set Plage = Freezer.Range("C5:L63")
        'Boucle
        For Each Cell In Plage
            If Cell.Value <> Empty Then
                If Cell.Value <> "Rack ID" Then
                    'Copie les valeurs du freezer interface
                    Workbooks(strFilename).Worksheets(1).Range("B" & LinB).Value = Cell.Value
                    'copie les couleurs
                    Workbooks(strFilename).Worksheets(1).Range("B" & LinB).Interior.Color = Cell.Interior.Color
                    'copie le nom du freezer
                    Workbooks(strFilename).Worksheets(1).Range("A" & LinB).Value = Freezer.Name
 
                    LinB = LinB + 1
                Else
                End If
            End If
        Next
    Next
    End With

Le second bout de code ci-dessous (9 min) consiste à comparer et supprimer parmi les 2430 valeurs collées précédemment à celles initialement dans le fichier strFilename (64 valeurs max).

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
derlig = Workbooks(strFilename).Worksheets(1).Range("B" & Rows.Count).End(xlUp).Row
 
    For i = 2 To derlig
        FindString = Workbooks(strFilename).Worksheets(1).Range("B" & i).Value
        If Trim(FindString) <> "" Then
            With Sheets(1).Range("E2:E65")
                Set Rng = .Find(What:=FindString, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
                If Rng Is Nothing Then
                    Sheets(1).Range("A" & i).Delete Shift:=xlUp
                    Sheets(1).Range("B" & i).Delete Shift:=xlUp
 
                    i = i - 1
                Else
                    Sheets(1).Range("C" & Rng.Row).Copy
                    Sheets(1).Range("F" & i).PasteSpecial xlPasteAll
                    Sheets(1).Range("D" & Rng.Row).Copy
                    Sheets(1).Range("G" & i).PasteSpecial xlPasteAll
 
                End If
            End With
        End If
    Next

17/07/2016, 15h30
Poussemousse

Bonjour et bienvenu sur le forum.

Pour la première macro (1min) je te conseille d'utiliser une image de la feuille dans laquelle tu viens scanner les valeurs qui sera de type Variant.
Tu peux aller voir ici : http://silkyroad.developpez.com/vba/tableaux/ c'est bien expliqué, cf un de mes posts qui m'a fait découvrir ce super pouvoir http://www.developpez.net/forums/d14...-l-espace-fin/.
En gros, au lieu de travailler sur chaque cellule, on ne travaille que sur une image allégée et qui en RAM dans l'ordi (accès plus rapide).

Pour la deuxième macro, si tu connais les valeurs cherchées que tu veux supprimer, pourquoi ne pas faire un filtre automatique dans la colonne que tu scannes en sélectionnant toutes les valeurs visées.
Une fois le tri effectué tu supprimes les N lignes concernées et le tour est joué.

J'espère avoir compris ce que tu cherchais à faire et que cela puisse t'aider.

Réponse à Poussemousse

Merci Poussemousse pour ta réponse et le tuto. Parmi les exemples proposés, je ne sais pas exactement sur lequel m'appuyer
Pour la 1ère macro, j'ai donc intégré le tableau de la façon suivante. Cependant j'ai encore quelques questions (voir ci-dessous ">>>>>").
Sans erreur, le temps de process est encore de 43 sec...

Pour la 2ème macro, malheureusement je ne connais pas les valeurs, elles changent systématiquement. Je vais essayer avec un tableau également.
Merci d'avance pour toute aide complémentaire.

Diane

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
Dim compt1 As Long, compt2 As Long
Dim PlageV As Variant
 
    For Each Freezer In ActiveWorkbook.Worksheets '>>>>>>>> puis-je faire des worksheet un tableau également ??
        PlageV = Freezer.Range("C5:L63").Value
        PlageC = Freezer.Range("C5:L63").Interior.Color  '>>>>>> est-ce possible de travailler avec les couleurs des cellules?
 
        'Boucle
        For compt1 = LBound(PlageV, 1) To UBound(PlageV, 1)
        For compt2 = LBound(PlageV, 2) To UBound(PlageV, 2)
            If PlageV(compt1, compt2) <> Empty Then
                    If PlageV(compt1, compt2) <> "Rack ID" Then
                        'Copie les valeurs du freezer interface
                        Workbooks(strFilename).Worksheets(1).Range("B" & LinB).Value = PlageV(compt1, compt2)
                        'copie les couleurs
                        Workbooks(strFilename).Worksheets(1).Range("B" & LinB).Interior.Color = PlageC(compt1, compt2)  '>>>>>>> ici j'ai une erreur (pas étonnant), dois-je faire un 2ème ensemble de "For compt1, compt2 Next" ?
                        'copie le nom du freezer
                        Workbooks(strFilename).Worksheets(1).Range("A" & LinB).Value = Freezer.Name
 
                        LinB = LinB + 1
                    Else
                    End If
            End If
        Next compt2
        Next compt1
    Next
 
    End With

Bonsoir
avant je pense que l'on est en presence d'un soucis de conception

dis moi quelle est la valeur de LinB au 1 er tour hein!!!!
Pour moi il vaut 0 ce qui par conséquence doit générer une erreur

ensuite tu boucle sur "for each....." dans une plage de plusieurs colonnes (Freezer.Range("C5:L63")) donc 10 colonnes

donc imaginons que sur la même ligne j'ai 10 valeurs différentes et pas une seule cellules vides et bien avec tes 3 lignes tu change 10 fois la cellules B et A
c'est peut être un peu pour cela que c'est long

bref toute une conception a revoir

je ne regarde pas le 2 eme code ayant déjà ici matière a réflexion n'est ce pas ????
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 For Each Freezer In ActiveWorkbook.Worksheets Set Plage = Freezer.Range("C5:L63") 'Boucle For Each Cell In Plage If Cell.Value <> Empty Then If Cell.Value <> "Rack ID" Then 'Copie les valeurs du freezer interface Workbooks(strFilename).Worksheets(1).Range("B" & LinB).Value = Cell.Value 'génère certainement une erreur au 1 er tour 'copie les couleurs Workbooks(strFilename).Worksheets(1).Range("B" & LinB).Interior.Color = Cell.Interior.Color' ici forcement pareil 'copie le nom du freezer Workbooks(strFilename).Worksheets(1).Range("A" & LinB).Value = Freezer.Name' idem LinB = LinB + 1 Else End If End If Next Next End With

je te propose ceci:

afin que tu puisse analyser dans la fenêtre d'exécution (debug) les adresses de cellules concernées par tes critères
je pense que ce chemin et mieux adapté a ton souhait

Code:

1
2
3
4
5
6
7
8
For Each Freezer In ActiveWorkbook.Worksheets
         With  Freezer .Range("$C$6:Ll$63")    ' plage a adapter
          .AutoFilter Field:=1, Criteria1:="<>", Criteria2:="<>Rack ID"  'on recherche les valeurs différentes de vide et de "rack id"
           'pour connaitre l'adress des cellules concernées par le filtre 
        debug .print .Parent.AutoFilter.Range.SpecialCells(xlCellTypeVisible)..Address
       .AutoFilter ' stop le filtre
    End With
next

Bonne méditation;)

21/07/2016, 19h37
dianedg

Re

Bonjour Patrick
La macro initiale fonctionne sans erreur, mais est juste super lente.
Les feuilles "freezer" sont verrouillées, pas possible d'appliquer un filtre. Et je ne veux pas les déverrouiller, il y a trop d'utilisateurs.
Ce que je pense faire : coller l'ensemble des valeurs du range sélection dans une seule colonne et appliquer les filtres (cellule vide et "rack id") ensuite. Il faudrait lire les données du tableau (range sélectionné) de gauche à droite puis de bas en bas. En gros transformer un tableau a 2 dimensions en un tableau a 1 dimension ? Pouvez-vous m'aiguiller?
Merci
21/07/2016, 20h36
patricktoulon

re

heu......

Citation:

Ce que je pense faire : coller l'ensemble des valeurs du range sélection dans une seule colonne et appliquer les filtres (cellule vide et "rack id") ensuite. Il faudrait lire les données du tableau (range sélectionné) de gauche à droite puis de bas en bas. En gros transformer un tableau a 2 dimensions en un tableau a 1 dimension ? Pouvez-vous m'aiguiller?

si tes cellules sont verrouillée et que tu ne peut pas faire de filtre c'est walouh ca aussi

peut être déverrouiller les cellules si l'utilisateur voir le nom du PC correspond au tiens ca c'est possible

exemple

Code:

if Envron("UserName") = "Diane " and Environ("COMPUTERNAME")="diane-PC" then........

si c'est ton pc qui lance c'est bon sinon walouh......