Comment alléger ma macro? (supression ligne lorsqu'une valeur apparaît)

[Résolu]
Signaler
Messages postés
6
Date d'inscription
lundi 26 novembre 2007
Statut
Membre
Dernière intervention
27 juillet 2011
-
Messages postés
6
Date d'inscription
lundi 26 novembre 2007
Statut
Membre
Dernière intervention
27 juillet 2011
-
Bonjour à tous,

J'ai créé des macros qui me permmettent de supprimer des lignes lorsque certaines valeurs apparaissent (ex valeur qui comment par "1" "2","sub", lorsqu'une cellule est vide.

Cependant c'est très long et "lourd", je désirerai tout compiler dans une seule et même macro.

Sub éliminator1()

 Dim c As Range

    Application.Calculation = xlCalculationManual
    Do
    Set c = Columns(4).Find("1*", , xlValues, xlWhole)
    If c Is Nothing Then GoTo fin
    c.EntireRow.delete
    Loop
    
    
fin:
Application.Calculation = xlCalculationAutomatic
End Sub

Sub éliminator2()

 Dim c As Range

    Application.Calculation = xlCalculationManual
    Do
    Set c = Columns(4).Find("2*", , xlValues, xlWhole)
    If c Is Nothing Then GoTo fin
    c.EntireRow.delete
    Loop
    
    
fin:
Application.Calculation = xlCalculationAutomatic
End Sub

Sub éliminator3()

 Dim c As Range

    Application.Calculation = xlCalculationManual
    Do
    Set c = Columns(4).Find("3*", , xlValues, xlWhole)
    If c Is Nothing Then GoTo fin
    c.EntireRow.delete
    Loop
    
    
fin:
Application.Calculation = xlCalculationAutomatic
End Sub
Sub éliminator4()

 Dim c As Range

    Application.Calculation = xlCalculationManual
    Do
    Set c = Columns(4).Find("4*", , xlValues, xlWhole)
    If c Is Nothing Then GoTo fin
    c.EntireRow.delete
    Loop
    
    
fin:
Application.Calculation = xlCalculationAutomatic
End Sub

Sub éliminator5()

 Dim c As Range

    Application.Calculation = xlCalculationManual
    Do
    Set c = Columns(4).Find("5*", , xlValues, xlWhole)
    If c Is Nothing Then GoTo fin
    c.EntireRow.delete
    Loop
    
    
fin:
Application.Calculation = xlCalculationAutomatic
End Sub

Sub éliminator613()

 Dim c As Range

    Application.Calculation = xlCalculationManual
    Do
    Set c = Columns(4).Find("613*", , xlValues, xlWhole)
    If c Is Nothing Then GoTo fin
    c.EntireRow.delete
    Loop
    
    
fin:
Application.Calculation = xlCalculationAutomatic
End Sub
Sub éliminator6214()

 Dim c As Range

    Application.Calculation = xlCalculationManual
    Do
    Set c = Columns(4).Find("6214*", , xlValues, xlWhole)
    If c Is Nothing Then GoTo fin
    c.EntireRow.delete
    Loop
    
    
fin:
Application.Calculation = xlCalculationAutomatic
End Sub

Sub éliminator63()

 Dim c As Range

    Application.Calculation = xlCalculationManual
    Do
    Set c = Columns(4).Find("63*", , xlValues, xlWhole)
    If c Is Nothing Then GoTo fin
    c.EntireRow.delete
    Loop
    
    
fin:
Application.Calculation = xlCalculationAutomatic
End Sub

Sub éliminator64()

 Dim c As Range

    Application.Calculation = xlCalculationManual
    Do
    Set c = Columns(4).Find("64*", , xlValues, xlWhole)
    If c Is Nothing Then GoTo fin
    c.EntireRow.delete
    Loop
    
    
fin:
Application.Calculation = xlCalculationAutomatic
End Sub

Sub éliminator65()

 Dim c As Range

    Application.Calculation = xlCalculationManual
    Do
    Set c = Columns(4).Find("65*", , xlValues, xlWhole)
    If c Is Nothing Then GoTo fin
    c.EntireRow.delete
    Loop
    
    
fin:
Application.Calculation = xlCalculationAutomatic
End Sub

Sub éliminator66()

 Dim c As Range

    Application.Calculation = xlCalculationManual
    Do
    Set c = Columns(4).Find("66*", , xlValues, xlWhole)
    If c Is Nothing Then GoTo fin
    c.EntireRow.delete
    Loop
    
    
fin:
Application.Calculation = xlCalculationAutomatic
End Sub

Sub éliminator681740()

 Dim c As Range

    Application.Calculation = xlCalculationManual
    Do
    Set c = Columns(4).Find("681740*", , xlValues, xlWhole)
    If c Is Nothing Then GoTo fin
    c.EntireRow.delete
    Loop
    
    
fin:
Application.Calculation = xlCalculationAutomatic
End Sub




Sub éliminator7()

 Dim c As Range

    Application.Calculation = xlCalculationManual
    Do
    Set c = Columns(4).Find("7*", , xlValues, xlWhole)
    If c Is Nothing Then GoTo fin
    c.EntireRow.delete
    Loop
    
    
fin:
Application.Calculation = xlCalculationAutomatic
End Sub

Sub éliminatorS()

 Dim c As Range

    Application.Calculation = xlCalculationManual
    Do
    Set c = Columns(4).Find("S*", , xlValues, xlWhole)
    If c Is Nothing Then GoTo fin
    c.EntireRow.delete
    Loop
    
    
fin:
Application.Calculation = xlCalculationAutomatic
End Sub

Sub supvide()
    Dim J As Long
Dim Plage As Range
Set Plage = Range("D5", Range("D1000").End(xlUp))
For J = Plage.Cells.Count To 1 Step -1
    If Plage.Cells(J).Value = "" Then
        Plage.Cells(J).EntireRow.delete
    End If
    
    Next
End Sub



Merci d'avance
Vinh

2 réponses

Messages postés
18038
Date d'inscription
lundi 7 décembre 2009
Statut
Modérateur
Dernière intervention
11 avril 2018
239
Compte tenu de ce nombre relativement élevé de critères de suppression, tu as intérêt à ne pas te servir de Find et à prilégier une boucle du genre
For each cellule in range(...)
...
Next

____________________
Utiliser le bouton "REPONSE ACCEPTEE" sur une réponse exacte facilite les recherches ultérieures d'autres forumeurs. PENSEZ-Y SVP
Messages postés
6
Date d'inscription
lundi 26 novembre 2007
Statut
Membre
Dernière intervention
27 juillet 2011

ça marche MERCI!