Discussion :

[Z0rKn4]

Bonjour à tous,

J'ai un petit soucis avec une macro que j'ai créer, en effet son exécution est très longue et je suis obligé de la lancer plusieurs fois pour que tout soit pris en compte...

Auriez vous une astuce pour que ce code fonctionne plus facilement ?

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
Public Maitre As Workbook
Public o As Worksheet
Public tbx As Workbook
Public nom_tbx As String
Public nom_fichier As Variant
 
 
 
 
Sub Supression_FO_saisie_terrain()
'
Tableaudesaisie = Application.GetOpenFilename(, , "Browse for workbook")
 
If Tableaudesaisie <> False Then
    Workbooks.Open Filename:=Tableaudesaisie
End If
 
nom_fichier = ActiveWorkbook.Name
 
 Set Maitre = Workbooks("Fichier Macro Maitre.xlsm")
 Set o = Maitre.Sheets("OUTILS")
 o.Activate
 
 Range("A10") = Tableaudesaisie
 
 Set tbx = Workbooks(nom_fichier)
 Set st = tbx.Sheets("Saisies terrain")
 st.Activate
 
 
'
'Initialisation
i = 9
 
 
'Boucle
While Range("S" & i) <> ""
If Range("A" & i) <> "" Then
Range("A" & i) = Range("A" & i)
Else
Range("A" & i) = Range("A" & i)
End If
 
Set MaPlage = Range("A" & i & ":AN" & i)
 
'Supression FO
On Error Resume Next
 
If Range("V" & i) = "standard" Then
Range("R" & i).Font.Bold = False
ElseIf Range("V" & i) = "haute" Then
MaPlage.Delete Shift:=xlUp
End If
 
 
'Surpression Forfait Optique
On Error Resume Next
 
If Range("A" & i) <> "" Then
Range("AA" & i) = "Non"
Else: Range("AA" & i) = Range("AA" & i)
End If
 
 
 
'Boucle
i = i + 1
Wend
 
'Supression matériel projeté
Range("AI9:AI5000").ClearContents
Range("AJ9:AJ5000").ClearContents
Range("AM9:AM5000").ClearContents
Range("AN9:AN5000").ClearContents
 
 
 
End Sub

Merci par avance pour vos astuces.

[Theze]

Bonjour,

Déjà, ceci ne sert à rien :

Code :

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

1
2
3
4
5
6
 
If Range("A" & i) <> "" Then
Range("A" & i) = Range("A" & i)
Else
Range("A" & i) = Range("A" & i)
End If

il en est de même pour cette ligne :

Code :

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

1
2
 
Else: Range("AA" & i) = Range("AA" & i)

Pour vider les cellules, au lieu de :

Code :

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

1
2
3
4
5
 
Range("AI9:AI5000").ClearContents
Range("AJ9:AJ5000").ClearContents
Range("AM9:AM5000").ClearContents
Range("AN9:AN5000").ClearContents

tu peux utiliser :

Code :

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

1
2
 
Range("AI9:AJ5000, AM9:AN5000").ClearContents

[Menhir]

Ce sont tes On Error Resume Next qui t'empêche de voir le problème.

De plus, quand on fait des Delete, on traite la liste du bas vers le haut, sinon, on loupe un ligne à chaque Delete.

Ton code un peu nettoyé :

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
Sub Supression_FO_saisie_terrain()
Dim Fin As Long, i As Long
Dim tbx As Workbook
 
Tableaudesaisie = Application.GetOpenFilename(, , "Browse for workbook")
If Tableaudesaisie <> False Then Set tbx = Workbooks.Open(Tableaudesaisie)
tbx.Sheets("Saisies terrain").Activate
 
'Boucle
Fin = Cells(Rows.Count, "S").End(xlUp).Row
For i = Fin To 9 Step -1
    Cells(i, 1).Value = Cells(i, 1).Value
 
    Set MaPlage = Range("A" & i & ":AN" & i)
 
    'Supression FO
    If Cells(i, 22) = "standard" Then
        Range(i, 18).Font.Bold = False
    ElseIf Cells(i, 22) = "haute" Then
        Rows(i).Delete
    End If
 
    'Surpression Forfait Optique
    Cells(i, 27).Value = Cells(i, 27).Value
    If Cells(i, 1) <> "" Then Cells(i, 27) = "Non"
Next i
 
'Supression matériel projeté
Range("AI9:AJ5000").ClearContents
Range("AM9:AN5000").ClearContents
 
End Sub

Petit détail que je n'ai pas corrigé : ton If Tableaudesaisie <> False Then ne sert à rien puisque tu ne gères pas ce qui se passe s'il n'y a pas de fichier sélectionné par le GetOpenFilname.
Plus précisément, tu ne prends pas en compte le cas "Else" de ce If, donc si aucun fichier n'est sélectionné, la ligne suivant va planter quand même, malgré le If.

Déjà, ceci ne sert à rien : Range("A" & i) = Range("A" & i)

Sauf s'il veut remplacer une formule par son résultat.
Si ces cellules ne contiennent pas de formule, effectivement ça ne sert à rien.

Pour vider les cellules, tu peux utiliser Range("AI9:AJ5000, AM9:AN5000").ClearContents

Sauf s'il veut conserver le contenu des colonnes AK et AL.
Si AK et AL ne contiennent rien d'utile, effectivement cette simplification est à conseiller.

[Z0rKn4]

Bonjour,

Merci pour votre aide.

Effectivement j'ai supprimer les lignes qui n'avait aucune utilité.

J'ai également utilisé la simplification des dernières lignes.

Cependant mon problème n'est toujours pas réglé, Excel "mouline" un moment avant d’exécuter le code.

J'ai des macros plus importante que celles ci qui vont boucler l'ouverture de classeurs et exécuter des tâches plus lourdes que celles ci et qui sont plus rapide... Je ne vois pas pourquoi...

[Theze]

Bonjour Menhir,

Sauf s'il veut remplacer une formule par son résultat.

Effectivement, si il veut remplacer les formules par les valeurs !

Sauf s'il veut conserver le contenu des colonnes AK et AL.
Si AK et AL ne contiennent rien d'utile, effectivement cette simplification est à conseiller.

Et bien, justement avec cette ligne de code ça épargne les colonnes AK et AL

[Z0rKn4]

Bonjour Menhir,

Merci pour ton aide et du temps que tu m'accorde.

Ton code fonctionne mieux que le mien j'ai du corrige une coquille "Range(i, 18)" au lieu de "Cells(i, 18)" hormis cela impeccable !

Concernant la condition "If Tableau de saisie <> False Then..." ; effectivement si je ne renseigne pas de fichier dans l'explorateur la macro plante.

J'ai tenté d'ajouter :

Code :

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

1
2
3
4
5
If Tableaudesaisie <> False Then Set tbx = Workbooks.Open(Tableaudesaisie)
tbx.Sheets("Saisies terrain").Activate
Else
Exit Sub
End if

Malheureusement il ne lie pas le Else au If

[Menhir]

Et bien, justement avec cette ligne de code ça épargne les colonnes AK et AL

Effectivement, tu as raison. Je n'avais pas bien lu le code.
Mea Culpa.

Concernant la condition "If Tableau de saisie <> False Then..." ; effectivement si je ne renseigne pas de fichier dans l'explorateur la macro plante.

J'ai tenté d'ajouter :

Code :

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

1
2
3
4
5
If Tableaudesaisie <> False Then Set tbx = Workbooks.Open(Tableaudesaisie)
tbx.Sheets("Saisies terrain").Activate
Else
Exit Sub
End if

Malheureusement il ne lie pas le Else au If

Lorsqu'on met une action sur la même ligne que le Then, il se referme à la fin de cette action.

Donc, la syntaxe correcte aurait été :

Code :

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

1
2
3
4
5
6
If Tableaudesaisie <> False Then 
   Set tbx = Workbooks.Open(Tableaudesaisie)
   tbx.Sheets("Saisies terrain").Activate
Else
     Exit Sub
End if

Mais il y a plus simple :

Code :

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

1
2
3
If Tableaudesaisie = False Then Exit Sub
Set tbx = Workbooks.Open(Tableaudesaisie)
tbx.Sheets("Saisies terrain").Activate

Un détail important : pense à indenter tes structures (If, With, boucles, etc.). Ca rendra ton code plus lisible et ça t'évitera des erreurs.
Regarde la différence de lisibilité entre ton premier code et le mien...