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