Liste de vérification sur excel en VBA

**djnewg** · 25/09/2018, 19h34

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,

**djnewg** · 25/09/2018, 19h36

Dans le processus du code.

Je fait un ping sur les postes sélectionnes.

Selon l'information que j'ai déjà en ma possession dans une feuille excel.
Je valide selon certain critère et inscrit un "Statut" et un "Résultat" préalablement choisie dans le code.

**djnewg** · 25/09/2018, 19h39

Serait-il possible aussi en VBA de Préciser dans le code que seul les champs sélectionner dans la colonne F permet d'activer la MACRO en question.

**RyuAutodidacte** · 26/09/2018, 01h13

Bonsoir,

Serait-il possible aussi en VBA de Préciser dans le code que seul les champs sélectionner dans la colonne F permet d'activer la MACRO en question.

Voir Intersect
Exemple Intersect dans l'évènement Worksheet_SelectionChange (à adapter selon la situation, dans ton cas en dehors d'une macro événementielle mais dans ton code) - le principe du code (à l'intérieur du sub) est le même, il faut remplacer la Target par la sélection…

avec cette recherche

vba Application.Intersect on tombe sur plusieurs exemples

Edit : Concernant ton code on ne met jamais de gestion d'erreur (On error resume next), et surtout pas en début de code.
La gestion d'erreur, on l'évite absolument, sauf dans les cas nécessaire déjà connus de plusieurs codes comme par exemple les codes concernant les Collections, ou les cas où on a pas le choix, mais cela veut dire que l'on connaît le type d'erreur inévitable dans une partie bien localisé du code.
LE fait de mettre la gestion d'erreur en début de code, nous empêche de voir les problématiques lors de l'exécution de ledit code.

Edit 2 : ajout de précision

**Menhir** · 26/09/2018, 10h13

Déjà, commence par supprimer (ou mettre en remarque) On Error Resume Next. Ca permettra de voir un éventuel problème.

Serait-il possible aussi en VBA de Préciser dans le code que seul les champs sélectionner dans la colonne F permet d'activer la MACRO en question.

D'après ce que tu montres, il ne s'agit pas d'une macro évènementielle. La macro est donc (sauf information contraire) "activée" à la main.
De plus, elle s'applique visiblement à "Selection", ce qui implique que l'opérateur doit choisir la zone à laquelle elle s'applique avant de la lancer.

A moins qu'il y ait une erreur dans ces deux constatation, je ne comprends pas ta question.

Je fait un ping sur les postes sélectionnes.

Je n'ai jamais fais de ping via du code, mais si ça prend le même temps que "à la main", ça fait quand même une seconde ou deux.
Si tu fais ça sur 10 000 adresses, ces secondes cumulées vont faire plusieurs heures.
Il ne serait donc pas étonnant que ton code mette beaucoup de temps à s'exécuter.

Tu devrais mettre un message simple (par exemple un debug.print) qui te permette de suivre l'avancement et de vérifier qu'il progresse sans bloquer (ou, au contraire, de voir où il bloque).

quand je fait Ctrl Pause, je vois bien qu'il bloque.

A quoi vois-tu ça ?

Liste de vérification sur excel en VBA

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager