Bonjour a tous

J'utilise Excel 2003 pour comparer dans une feuille Excel 4200 numéro de série.
La macro que j'ai fais prend le premier numéro de la colonne, cherche dans la même colonne du haut vers le bas.
Si le numéro de série est pressent 2 fois les cellules changer de couleur, sinon en passe a la ligne suivant et fais le même test jusqu'a la fin du fichier.
le tous sur le même colonne.

Pour 4200 va tester, cela me prendre 2:30 environ.

Y a t'il sur Excel ou avec une autre solution de développement la possibilité de diviser le temps par 5 pour 10.

Vu que je ne suis pas un PRO de la macro sur Excel je vous copie le code.


Ps: désole pour les fautes.


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
Sub rechvaleur()
 
'Se placer en haut de la colonne
 
Range("F2").Activate
 
'Boucle pour tester toutes les cellules de la colonne
 
Do While ActiveCell.Value <> ""
 
    'Variable qui stocke la valeur de la cellule actuelle
 
    valrech = ActiveCell.Value
 
    'Variable qui initialise si la valeur est trouvée
 
    valtrouv = 0
 
    'Variable qui stock l'adresse de la valeur recherchée
 
    advalrech = ActiveCell.Address
 
    'On revient en haut de la colonne
 
    Range("F2").Activate
 
    'Nouvelle boucle permettant de rechercher dans la colonne
 
    Do While ActiveCell.Value <> ""
 
        'si l'adresse de la cellule actuelle est différente de l'adresse de la valeur recherchée
 
        'alors on met le cellule est rouge et on met la variable valtrouv a 1
 
        If ActiveCell.Address <> advalrech Then
 
            If ActiveCell.Value = valrech Then ActiveCell.Interior.ColorIndex = 3
 
            If ActiveCell.Value = valrech Then valtrouv = 1
 
        End If
 
        'On passe a la ligne suivante
 
        ActiveCell.Offset(1, 0).Activate
 
    Loop
 
    'On revient sur la cellule de notre valeur recherchée
 
    Range(advalrech).Activate
 
    'Si valtrouv = 1, on met le le cellule est rouge
 
    If valtrouv = 1 Then ActiveCell.Interior.ColorIndex = 3
 
    'On passe à la ligne suivante
 
    ActiveCell.Offset(1, 0).Activate
 
Loop
 
End Sub

Merci.