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

Youssef -
michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention - 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.

Afficher la suite

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
Jitbit macro recorder - Télécharger - Confidentialité
Télécharger macro convertir chiffre en lettre excel - Télécharger - Tableur
Telecharger adobe premiere pro gratuit windows 10 - Télécharger - Montage & Édition
Mon pc est trop lent et se bloque - Guide

2 réponses

Réponse 1 / 2

Frenchie83 Messages postés 2240 Date d'inscription Statut Membre Dernière intervention 338

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 16602 Date d'inscription Statut Contributeur Dernière intervention 3 314

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

paiment 4x nickel sur top achat

Devinette

Paiement en 4 fois cdiscount

Problème paiement 4 fois cdiscount

imprimer plusieurs fois la meme photos sur la meme page

Votre réponse

Discussions similaires