Bonjour,

J'ai pondu un petit script pour analyser mes 10000 ligne, mais j'ai un problème.
Sois le fichier excel ne répond plus ou sinon il est très lent et quand je fait Ctrl Pause, je vois bien qu'il bloque.

Voici mon code, seriez-vous en mesure de me guider à savoir ce que je peut faire pour arranger la situation, histoire de maximiser le résultat et minimiser le temps et l'effort qu'a à fournir excel lors de l’exécution de la macro.

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
 
 
Sub Vérif_Selection()
On Error Resume Next
Dim Rng As Range, cell As Range
Dim Tab_Ra As Range, objhttp As Variant, PingResult As Variant, Computer$, IP As String
'Dim cellCA As Range, cellEPO As Range, cellEPOM As Range
Dim Cell_CA As Variant, Cell_EPO As String, Cell_EPOM As String, Cell_Result As String
 
Set Rng = Selection
 
'Selection
'Range("E6898:E7255")
For Each cell In Rng
    If cell.Offset(0, 20).Value = "Non" Then 'Valide si il sagit d'une exception
        If cell.Offset(0, -4).Value = "" Or cell.Offset(0, -3).Value = "Poste Non Actif" Then 'Ping le poste
                Computer$ = Trim(cell.Offset(0, -2).Value) & "PT": IP = ""
                For Each PingResult In GetObject("winmgmts://./root/cimv2").ExecQuery _
                    ("SELECT * FROM Win32_PingStatus WHERE Address = '" & Computer$ & "'")
                    If IsObject(PingResult) Then IP = PingResult.ProtocolAddress
                Next
                If IP = "" Then
                cell.Offset(0, -4).Value = "X"
                'cell.Offset(0, -3).Value = "Poste Non Actif"
                Else: cell.Offset(0, -4).Value = "V"
                End If
    '            IP
        End If
        If cell.Offset(0, -4) = "X" Then 'Si le résultat du ping est négatif
            If cell = "06- RETIRÉ (SURPLUS)" Then
                If cell.Offset(0, 2) < cell.Offset(0, 18) Then
                    cell.Offset(0, -5) = "À Supprimer"
                    cell.Offset(0, -3) = "Retiré, Non Actif"
                Else
                    cell.Offset(0, -5) = "À Valider"
                    cell.Offset(0, -3) = "Retiré, actif"
                End If
            End If
 
            If cell <> "07- RETIRÉ (CÉDÉ)" Or cell <> "08- RETIRÉ (REMPLACÉ GARANTIE)" Or cell <> "09- RETIRÉ (INTROUVABLE)" Or cell <> "10- RETIRÉ (SURPLUS À FAIRE)" Or cell <> "06- RETIRÉ (SURPLUS)" Then
                If cell.Offset(0, 16) <> "Actif" Then 'Vérif Cell AD autre que Actif
                    If cell.Offset(0, -4).Value = "X" Then
                        cell.Offset(0, -5) = "À valider"
                        cell.Offset(0, -3) = "Inventaire, non actif" 'Inscription Si non actif et pas dans L'AD
                    Else
                        cell.Offset(0, -5) = "Conforme"
                        cell.Offset(0, -3) = "Inventaire, Actif, pas dans l'AD" 'Inscription actif et pas dans L'AD
                    End If
                Else
                    If cell = "02- REÇU" Then
                        cell.Offset(0, -5) = "À valider"
                        cell.Offset(0, -3) = "Reçu, Actif"
                    ElseIf cell.Offset(0, -1) = "NULL" Then  'Vérif CA14 à NULL
                        If cell.Offset(0, -4).Value = "X" Then 'Pas de Ping
                            cell.Offset(0, -5) = "À valider"
                            cell.Offset(0, -3) = "Inventaire, pas actif, pas dans CA" 'Inscription Si AD non Actif et CA14 NULL
                        Else
                            cell.Offset(0, -5) = "À valider"
                            cell.Offset(0, -3) = "Inventaire, actif, pas dans CA" 'Inscription Si AD Actif et CA14 NULL
                        End If
                    Else
                        If cell.Offset(0, 15) < Now() - 90 Then 'Vérif EPO 3 dernier mois
                            cell.Offset(0, -5) = "À valider"
                            cell.Offset(0, -3) = "Inventaire, non actif, pas com EPO"
                        Else
                            cell.Offset(0, -5) = "À valider"
                            cell.Offset(0, -3) = "Inventaire, actif, pas com EPO"
                        End If
                    End If
                End If
            End If
            If cell = "07- RETIRÉ (CÉDÉ)" Or cell = "08- RETIRÉ (REMPLACÉ GARANTIE)" Or cell = "09- RETIRÉ (INTROUVABLE)" Or cell = "10- RETIRÉ (SURPLUS À FAIRE)" Then
                If cell.Offset(0, 18) = "NULL" Then
                    cell.Offset(0, -5) = "À Supprimer"
                    cell.Offset(0, -3) = "Retiré, Non Actif"
                ElseIf cell.Offset(0, 18) < Now() - 180 Then
                    cell.Offset(0, -5) = "À Supprimer"
                    cell.Offset(0, -3) = "Retiré, Non Actif"
                Else
                    cell.Offset(0, -5) = "À valider"
                    cell.Offset(0, -3) = "Retiré, actif les 6 dernier mois"
                End If
            End If
        Else
            If cell = "06- RETIRÉ (SURPLUS)" Then
                cell.Offset(0, -5) = "À valider"
                cell.Offset(0, -3) = "Retiré, Actif"
            End If
            If cell = "06- RETIRÉ (CÉDÉ)" Or cell = "06- RETIRÉ (REMPLACÉ GARANTIE)" Or cell = "06- RETIRÉ (INTROUVABLE)" Or cell = "06- RETIRÉ (SURPLUS À FAIRE)" Then
                cell.Offset(0, -5) = "À valider"
                cell.Offset(0, -3) = "Retiré, Actif"
            End If
        End If
    Else
        cell.Offset(0, -3) = "Exception"
        cell.Offset(0, -5) = "À valider"
    End If
Next cell
Set objhttp = Nothing
End Sub
Je suis ouvert pour tout suggestion et ainsi pouvoir améliorer mon code
Merci,