Optimisation de comparaison de (long) tableau

**kaahlrv** · 27/07/2009, 15h38

Bonjour,

Je sollicite votre aide non pas pour un blocage (tout marche) mais pour une question d'optimisation.

Je ne suis pas développeur, mais je bidouille Excel.

J'ai un fichier contenant le résultat de 3 requêtes sur Oracle:
LISTING : 16369 lignes sur 8 colonnes
TRIABLE : 1508 lignes sur 21 colonnes

Desquels j'extrais ceux correspondant aux communes saisies sur une autre page.

cela est quasi instantané et me convient bien

j'ai donc un 3é onglets contenant le résultat
POSTE : 347 lignes 8 colonnes

Je dois exclure les déjà traiter via une comparaison avec un autre onglet de CR T : 71 lignes et 11 colonnes

et copier les traitements Non terminai qui concerne les communes choisies
CR N : 739 lignes sur 32 colonnes

je me retrouve à la fin avec un onglet contenant POSTE des communes choisies diminuées des déjà traiter (CR T)
307 lignes 8 colonnes
et une liste réduite de CR choix
12 lignes 32 colonnes

La seconde parties prend quasiment 15 minutes !

pendant ce temps l'onglet CR et l'onglet POSTE clignotes très très rapidement
ce qui laisse pensé que c le choix des CR correspondant aux postes qui pose problème, car je balaye pour chaque POSTE l'ensemble des CR a la recherche d'une correspondance...

Mais cela ne justifie pas 15 min de traitement sur un PC portable récent HP 2.13Ghz 2GO de ram avec Windows 2000.

Qu'en pensez-vous?

D'ailleurs est ce normal que ce fichier XLS fasse + de 12Mo ? Mes tableaux sont à considérer comme très lourd ?

ci-dessous l'ensemble du code
(il y a également des parties re-nommage de doublon, mais ce n'est pas cela qui rallonge le traitement je pense)

Si quelqu'un comprend d'où cela viens ...

Test effectuer avec peux de CR N et cela semble plus rapide, mais encore lent par rapport à ce qui est réellement effectuer

Au sujet de la mise a dispo des données, je pourrais modifier mon fichier mais il contient uniquement des données nominative, sensible et que je n'ai pas le droit de diffusé !

1er partie qui dure 6 à 7 secondes

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
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
Sub triautoPoste()
y = "data"
 
'liste ville demandé sans doublon
Sheets("liste postes demander").Select
 
    Columns("B:B").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Columns( _
        "B:B"), CopyToRange:=Columns("C:C"), Unique:=True
        If Range("a1").Value <> "" Then
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown
    End If
'balayage liste ville demandé
    Range("C1").Select
    While ActiveCell.Offset(1, 0).Value <> ""
    ActiveCell.Offset(1, 0).Select
'mise en variable ville demandé
 
    x = ActiveCell.Value
'reglage tri dans liste
 
    Sheets("Listing triable").Select
 
    ActiveWindow.SmallScroll ToRight:=5
    Selection.AutoFilter Field:=10, Criteria1:=x
    ActiveWindow.SmallScroll ToRight:=8
    ActiveWindow.LargeScroll ToRight:=-2
    Selection.AutoFilter Field:=9, Criteria1:="Dans le périmètre"
    ActiveWindow.LargeScroll ToRight:=2
    ActiveWindow.SmallScroll ToRight:=5
    ActiveWindow.LargeScroll ToRight:=-1
    ActiveWindow.SmallScroll ToRight:=-11
    ActiveWindow.LargeScroll ToRight:=1
    ActiveWindow.SmallScroll ToRight:=3
    Selection.AutoFilter Field:=15, Criteria1:="<>"
    ActiveWindow.LargeScroll ToRight:=-3
    ActiveWindow.SmallScroll ToRight:=3
    ActiveWindow.LargeScroll ToRight:=-1
    Range("A6").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Rows("6:6").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
'collage dans feuille demande
Sheets("postes").Select
    Range("A1").Select
    'collage a lasuite
If Range("a1").Value <> "" Then
    Selection.End(xlDown).Select
        ActiveCell.Offset(1, 0).Select
      End If
ActiveSheet.Paste
    y = x
    Sheets("liste postes demander").Select
Wend
 
' rechercheV
Sheets("postes").Select
    Columns("A:G").Select
    Selection.Delete Shift:=xlToLeft
    Columns("B:K").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
 
    Selection.End(xlDown).Select
    l = Selection.Row
'copie poste
Sheets("postes").Select
    Range("B1").Select
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(RC1,'Listing complet poste'!R1:R65536,2,FALSE)"
    Range("B1").Select
    Selection.AutoFill Destination:=Range("B1:B" & l & "")
    Range("B1:B" & l & "").Select
    Range("B1").Select
    Selection.Copy
    Range("C1").Select
    ActiveSheet.Paste
    Range("D1").Select
    ActiveSheet.Paste
    Range("E1").Select
    ActiveSheet.Paste
    Range("F1").Select
    ActiveSheet.Paste
    Range("G1").Select
    ActiveSheet.Paste
    Range("H1").Select
    ActiveSheet.Paste
    Range("C1").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(RC1,'Listing complet poste'!R1:R65536,3,FALSE)"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(RC1,'Listing complet poste'!R1:R65536,4,FALSE)"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(RC1,'Listing complet poste'!R1:R65536,5,FALSE)"
    Range("F1").Select
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(RC1,'Listing complet poste'!R1:R65536,6,FALSE)"
    Range("G1").Select
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(RC1,'Listing complet poste'!R1:R65536,7,FALSE)"
    Range("H1").Select
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(RC1,'Listing complet poste'!R1:R65536,8,FALSE)"
    Range("C1:H1").Select
    Range("H1").Activate
    Selection.AutoFill Destination:=Range("C1:H" & l & "")
    Range("C1:H" & l & "").Select
    Cells.Select
    Cells.EntireColumn.AutoFit
 
'copie valeurs cellule (suppression des rechercheV)
Sheets("postes").Select
Cells.Select
    Range("D6").Activate
    Selection.Copy
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Range("E16").Select
 
 
'tri ordre code gdo
 
    Cells.Select
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Sheets("CR").Select
    Cells.Select
    Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

A partir de la ca "clignote" et ce clignotement dure 10 15minutes :s

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
 
'CR auto
Sheets("postes").Select
i = 1
j = 1
k = 1
copie = 1
While Range("A" & i & "").Value <> ""
 
Sheets("postes").Select
    p = Range("a" & i & "").Value
Sheets("CR").Select
    cr = Range("B" & j & "").Value
    While cr <> ""
        If cr = p Then
         Sheets("CR").Rows(j).Copy Destination:=Sheets("CR choisi").Rows(k)
            k = k + 1
            copie = j
            j = 65000 ' pour sortir de la boucle < peut etre la source du probleme mais je ne sais pas faire autrement
        End If
    j = j + 1
    Sheets("CR").Select
    cr = Range("B" & j & "").Value
    Sheets("postes").Select
    p = Range("a" & i & "").Value
 
    Wend
Sheets("postes").Select
    i = i + 1
    j = copie
Wend

La fin est instantanée

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
 
 
 
Sheets("liste postes demander").Select
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
 
'renommage doublon poste
    Sheets("postes").Select
    i = 1
 
While Range("A" & i & "").Value <> ""
    If Range("A" & i & "").Value = Range("A" & i + 1 & "").Value Then
        Range("A" & i + 1 & "").Value = Range("A" & i + 1 & "").Value & "R"
         doublon = 1
        If doublon = 1 Then
            If Range("A" & i & "").Value = Range("A" & i + 2 & "").Value Then
            Range("A" & i + 2 & "").Value = Range("A" & i + 2 & "").Value & "S"
            doublon = 2
                If doublon = 2 Then
                    If Range("A" & i & "").Value = Range("A" & i + 3 & "").Value Then
                    Range("A" & i + 3 & "").Value = Range("A" & i + 3 & "").Value & "T"
                    doublon = 3
                        If doublon = 3 Then
                            If Range("A" & i & "").Value = Range("A" & i + 4 & "").Value Then
                            Range("A" & i + 4 & "").Value = Range("A" & i + 4 & "").Value & "U"
                            doublon = 4
                            End If
                        End If
                    End If
                End If
            End If
        End If
    End If
 
    i = i + 1
 
Wend
'renommage suppression doublon CR
        Sheets("CR Choisi").Select
        i = 1
        doulon = 0
While Range("B" & i & "").Value <> ""
    If Range("B" & i & "").Value = Range("B" & i + 1 & "").Value Then
        If Range("E" & i & "").Value = Range("E" & i + 1 & "").Value Then
                Rows("" & i + 1 & ":" & i + 1 & "").Select
                Selection.Delete Shift:=xlUp
        Else
            Range("B" & i + 1 & "").Value = Range("B" & i + 1 & "").Value & "R"
                i = i + 1
        End If
    Else
    i = i + 1
    End If
Wend
    'enregistrement fichiers
 
    ChDir "C:\"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\CR.csv", FileFormat:=xlCSV, _
        CreateBackup:=False
    Sheets("postes").Select
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Postes.csv", FileFormat:=xlCSV, _
        CreateBackup:=False
 
 
End Sub

Merci d'avance
J'en ai marre d'attendre devant mon poste qu'il finisse sa moulinette
Et je v finir épileptique à regarder ce clignotement !

EDIT : orthographe et présentation

**kaahlrv** · 27/07/2009, 16h03

dans l'onglet POSTE j'ai 307 lignes mais 88 ligne "vide" qui appraissent en CSV sous forme de ;;;;;;

ses lignes ne sont meme pas a la suite ni repartie de facon reguliere ...

dans le CR.CSV il y a egalement des lignes (enfin cellule) de ;;;;;; mais ce coup si j'ai 13 lignes valide pour 13 vides... et a la suite... celle ci.

Toute ma macro est a revoir ? ou l'enregistrement en CSV cree til des lignes "vide" ?

**Krovax** · 27/07/2009, 16h24

Bonjour
Une des première chose a faire pour accélérer un code et d'enlever la totalité des instruction select. (un dernier select a la fin de la macro pour positionner l'utilisater au bon endroit est tout de même possible)
Exemples de simplification

Code :

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

1
2
3
4
Sheets("postes").Select
    p = Range("a" & i & "").Value
Sheets("CR").Select
    cr = Range("B" & j & "").Value

devient

Code :

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

1
2
    p = Sheets("postes").Range("a" & i & "").Value
    cr = Sheets("CR").Range("B" & j & "").Value

ceci

Code :

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

1
2
3
   Range("C1").Select
    While ActiveCell.Offset(1, 0).Value <> ""
    ActiveCell.Offset(1, 0).Select

Pourrais être remplacé par une judisieuse boucle for pour i allant de 1 à la dernière ligne

Code :

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

1
2
for i= 2 to Sheets("liste postes demander").Range("A65536").End(xlUp).Row
Sheets("liste postes demander").cells(i,3) ce que tu veux lui faire

Des bloc with peuvent te servir a alléger la syntaxe.

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
 
While Range("A" & i & "").Value <> ""
 
Sheets("postes").Select
    p = Range("a" & i & "").Value
Sheets("CR").Select
    cr = Range("B" & j & "").Value
    While cr <> ""
        If cr = p Then
         Sheets("CR").Rows(j).Copy Destination:=Sheets("CR choisi").Rows(k)
            k = k + 1
            copie = j
            j = 65000 ' pour sortir de la boucle < peut etre la source du probleme mais je ne sais pas faire autrement
        End If
    j = j + 1
    Sheets("CR").Select
    cr = Range("B" & j & "").Value
    Sheets("postes").Select
    p = Range("a" & i & "").Value
 
    Wend
Sheets("postes").Select
    i = i + 1
    j = copie
Wend

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
for i = 1 to Range("A65536").End(xlUp).Row
 
    p = Sheets("postes").Range("a" & i & "").Value
 
    cr = Sheets("CR").Range("B" & j & "").Value
    While cr <> ""
        If cr = p Then
         Sheets("CR").Rows(j).Copy Destination:=Sheets("CR choisi").Rows(k)
            k = k + 1
            copie = j
            j = 65000 ' pour sortir de la boucle < peut etre la source du probleme mais je ne sais pas faire autrement
        End If
    j = j + 1
 
    cr = Sheets("CR").Range("B" & j & "").Value
 
    p = Sheets("postes").Range("a" & i & "").Value
 
    Wend
 
    j = copie
next i

Je te laisse commencer par nettoyer tout ca

Ensuite place en début de macro

Code :

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

Application.ScreenUpdating = False

et a la fin

Code :

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

Application.ScreenUpdating = true

**ouskel'n'or** · 27/07/2009, 16h27

Tes clignotements me font penser à plusieurs lacunes. Commence par mettre
Application.screenUpdating = false en tout début de macro, et tu le repasses à True en fin de macro

Code :

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

1
2
3
4
5
6
Sub Lamacro()
     Application.screenUpdating = false
         'Ton code
 
     Application.screenUpdating = True
End sub

Ensuite, et là c'est pas gagné, supprime tous tes Select car ce sont eux qui provoquent les mvts de pages car ils imposent à Excel d'aller d'un point à un autre d'une feuille voir du classeur.
Un exemple :

Sheets("postes").Select
Columns("A:G").Select
Selection.Delete Shift:=xlToLeft

A remplacer par

Code :

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

Sheets("postes").Columns("A:G").Delete Shift:=xlToLeft

Bon courage

Pssst - et une fois de plus grillé par... KROVAX !

**kaahlrv** · 27/07/2009, 17h03

merci beaucoup

en effet deja de retirer les switchs d'onglet accelere le traitement !

mais j'ai aussi reflechi (et je me suis fait aider par une jeune stagiaire, mais futur ingenieur)

et donc voila la double boucle qui prend 2 sec au lieu de 15 minutes !

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
p = Sheets("postes").Range("a" & i & "").Value
cr = Sheets("CR").Range("B" & j & "").Value
While p <> "" And cr <> ""
    p = Sheets("postes").Range("a" & i & "").Value
    While Sheets("CR").Range("B" & j & "").Value < Sheets("postes").Range("a" & i & "").Value And Sheets("CR").Range("B" & j & "").Value <> ""
        j = j + 1
    Wend
    cr = Sheets("CR").Range("B" & j & "").Value
    If cr = p Then
        Sheets("CR").Rows(j).Copy Destination:=Sheets("CR choisi").Rows(k)
        k = k + 1
                j = j + 1
    End If
    i = i + 1
Wend

Merci de votre reactivité (si j'avais su quelle etait si competente je vous aurais pas demander , et inversement

)

Optimisation de comparaison de (long) tableau [XL-2000]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager