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

Question

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

ucfoutu · Accepted Answer

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

nhanvin · Answer

ça marche MERCI!

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

2 réponses

Votre réponse

Discussions similaires