Sujet Précédent Sujet Suivant

Macro lente et s'exécute la première fois seulement

Fermé

Youssef - Modifié le 19 janv. 2018 à 19:44
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 - 22 janv. 2018 à 11:14

Bonjour,

je viens vers vous pour m'aider à corriger le problème de lenteur d'une macro en phase exploitation

Il s'agit d'une mecro pour supprimer les lignes et les colonnes vides en sous total.

En utilisant la macro sur cinq feuilles dans le fichier excel (OF_MP_GM_1 à 5), ce dernier passe beaucoup de temps pour l'exécution.

Est-ce-que vous avez des améliorations à me proposer. Mille est un merci d'avance

Sub SupprimerSousTotalNul()

Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual

Set Feuille = ActiveSheet "Là pour revenir à la feuille d'accueil après l'exécution"

Sheets("OF_MP_GM_1").Select

'Recherche emplacement de Sous total
Set C = Rows("8").Find("S.Total.Commande", LookIn:=xlValues)
If C Is Nothing Then
MsgBox "La colonne ""S.Total.Commande"" est introuvable ou mal orthographiée"
Exit Sub
End If

Set L = Columns("A").Find("S.Total.Bobine", LookIn:=xlValues)
If L Is Nothing Then
MsgBox "La ligne ""S.Total.Bobine"" est introuvable ou mal orthographiée"
Exit Sub
End If

'recherche et suppression des 0 par lignes
For i = L.Row - 1 To 8 Step -1
If Cells(i, C.Column) = 0 Then Cells(i, C.Column).EntireRow.Delete
Next i

'recherche et suppression des 0 par colonnes
For i = C.Column - 1 To 3 Step -1
If Cells(L.Row, i) = 0 Then Range(Cells(8, i), Cells(L.Row, i)).Delete
Next i

Sheets("OF_MP_GM_2").Select

'Recherche emplacement de Sous total
Set C = Rows("8").Find("S.Total.Commande", LookIn:=xlValues)
If C Is Nothing Then
MsgBox "La colonne ""S.Total.Commande"" est introuvable ou mal orthographiée"
Exit Sub
End If

Set L = Columns("A").Find("S.Total.Bobine", LookIn:=xlValues)
If L Is Nothing Then
MsgBox "La ligne ""S.Total.Bobine"" est introuvable ou mal orthographiée"
Exit Sub
End If

'recherche et suppression des 0 par lignes
For i = L.Row - 1 To 8 Step -1
If Cells(i, C.Column) = 0 Then Cells(i, C.Column).EntireRow.Delete
Next i

'recherche et suppression des 0 par colonnes
For i = C.Column - 1 To 3 Step -1
If Cells(L.Row, i) = 0 Then Range(Cells(8, i), Cells(L.Row, i)).Delete
Next i

Sheets("OF_MP_GM_3").Select

'Recherche emplacement de Sous total
Set C = Rows("8").Find("S.Total.Commande", LookIn:=xlValues)
If C Is Nothing Then
MsgBox "La colonne ""S.Total.Commande"" est introuvable ou mal orthographiée"
Exit Sub
End If

Set L = Columns("A").Find("S.Total.Bobine", LookIn:=xlValues)
If L Is Nothing Then
MsgBox "La ligne ""S.Total.Bobine"" est introuvable ou mal orthographiée"
Exit Sub
End If

'recherche et suppression des 0 par lignes
For i = L.Row - 1 To 8 Step -1
If Cells(i, C.Column) = 0 Then Cells(i, C.Column).EntireRow.Delete
Next i

'recherche et suppression des 0 par colonnes
For i = C.Column - 1 To 3 Step -1
If Cells(L.Row, i) = 0 Then Range(Cells(8, i), Cells(L.Row, i)).Delete
Next i

Sheets("OF_MP_GM_4").Select

'Recherche emplacement de Sous total
Set C = Rows("8").Find("S.Total.Commande", LookIn:=xlValues)
If C Is Nothing Then
MsgBox "La colonne ""S.Total.Commande"" est introuvable ou mal orthographiée"
Exit Sub
End If

Set L = Columns("A").Find("S.Total.Bobine", LookIn:=xlValues)
If L Is Nothing Then
MsgBox "La ligne ""S.Total.Bobine"" est introuvable ou mal orthographiée"
Exit Sub
End If

'recherche et suppression des 0 par lignes
For i = L.Row - 1 To 8 Step -1
If Cells(i, C.Column) = 0 Then Cells(i, C.Column).EntireRow.Delete
Next i

'recherche et suppression des 0 par colonnes
For i = C.Column - 1 To 3 Step -1
If Cells(L.Row, i) = 0 Then Range(Cells(8, i), Cells(L.Row, i)).Delete
Next i

Sheets("OF_MP_GM_5").Select

'Recherche emplacement de Sous total
Set C = Rows("8").Find("S.Total.Commande", LookIn:=xlValues)
If C Is Nothing Then
MsgBox "La colonne ""S.Total.Commande"" est introuvable ou mal orthographiée"
Exit Sub
End If

Set L = Columns("A").Find("S.Total.Bobine", LookIn:=xlValues)
If L Is Nothing Then
MsgBox "La ligne ""S.Total.Bobine"" est introuvable ou mal orthographiée"
Exit Sub
End If

'recherche et suppression des 0 par lignes
For i = L.Row - 1 To 8 Step -1
If Cells(i, C.Column) = 0 Then Cells(i, C.Column).EntireRow.Delete
Next i

'recherche et suppression des 0 par colonnes
For i = C.Column - 1 To 3 Step -1
If Cells(L.Row, i) = 0 Then Range(Cells(8, i), Cells(L.Row, i)).Delete
Next i


Feuille.Select

MsgBox "Suppression des commandes nulles effectuée", 64
Exit Sub

Application.Calculation = xlCalculationAutomatic

End Sub

EDIT : Ajout des balises de code (la coloration syntaxique).
Explications disponibles ici : ICI

Merci d'y penser dans tes prochains messages.

A voir également:

Macro lente et s'exécute la première fois seulement
Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
Mon pc est trop lent et se bloque - Guide
Macro word - Guide
Qu'est ce qu'une femme fait 3 fois par jour et un homme une fois dans sa vie ✓ - Forum Loisirs / Divertissements
Je suis une chose que les garçons utilisent deux fois par jour et les filles une fois toute leur vie - Forum Loisirs / Divertissements

2 réponses

Réponse 1 / 2

Frenchie83 Messages postés 2240 Date d'inscription lundi 6 mai 2013 Statut Membre Dernière intervention 11 août 2023 338
20 janv. 2018 à 09:13

Bonjour,
Macro raccourcie, mais ne connaissant pas la taille de chaque feuille, je ne peux pas tester la rapidité d'exécution.

Sub SupprimerSousTotalNul()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Feuille = ActiveSheet.Name '"Là pour revenir à la feuille d'accueil après l'exécution"
    For i = 1 To 5
        Sheets("OF_MP_GM_" & i).Select
        Traitement
    Next i
    Sheets(Feuille).Select
    MsgBox "Suppression des commandes nulles effectuée"
    Application.Calculation = xlCalculationAutomatic
End Sub

Sub Traitement()
    Application.ScreenUpdating = False
    'Recherche emplacement de Sous total
    Set C = Rows("5").Find("S.Total.Bobine", LookIn:=xlValues)
    If C Is Nothing Then
        MsgBox "La colonne ""S.Total.Bobine"" est introuvable ou mal orthographiée"
        Exit Sub
    End If

    Set L = Columns("A").Find("S.Total.Commande", LookIn:=xlValues)
    If L Is Nothing Then
        MsgBox "La ligne ""S.Total.Commande"" est introuvable ou mal orthographiée"
        Exit Sub
    End If
    
    'recherche et suppression des 0 par lignes
    For i = L.Row - 1 To 6 Step -1
        If Cells(i, C.Column) = 0 Then Cells(i, C.Column).EntireRow.Delete
    Next i
    
    'recherche et suppression des 0 par colonnes
    For i = C.Column - 1 To 2 Step -1
        If Cells(L.Row, i) = 0 Then Range(Cells(5, i), Cells(L.Row, i)).Delete
    Next i
End Sub

Cdlt

Réponse 2 / 2

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 310
22 janv. 2018 à 11:14

Binjour

frenchie excuse l'inscruste

Youssef :
je n'ai pas compris l'intérêt de rechercher les sous totaux à la fin mais il est facile de relancer la sous macro "vérifier...."

Sans avoir le classeur sous les yeux ; j'ai travaillé " à l'aveugle" et donc, les erreurs sont probables; dans ce cas:
pour communiquer un classeur
Mettre le classeur sans données confidentielles en pièce jointe sur
https://mon-partage.fr/
Puis faire un clic droit copier le raccourci et coller dans votre message

code proposé dans ce classeur-maquette:
https://mon-partage.fr/f/WgLcKdvP/

Discussions similaires

Que peut faire 3fois/j un homme, mais qu'1fois/j une femme

paiment 4x nickel sur top achat

Masque diapositives : superposition image et forme

une image de quelque seconde sur une vidéo

Pourquoi 3 fois !?

Forum VB / VBA