Macro : Supprimer ligne entière si une cellule contient la valeur "X"

Bonjour,

Ne connaissant pas du tout VBA, est-ce que l'un ou l'une de vous pourrait me concocter une macro afin de :

- Supprimer la ligne si, dans la cellule en colonne S de l'onglet "Données", la valeur est "SupprimerLigne"

- Ceci sur la plage de cellules allant de A1 à BH3001

Je vous ai mis en PJ le fichier totalement anonymisé (Nom, prénom, numéro de sécurité sociale, matricules, société, SIRET, SIREN,...)

J'ai essayé différents codes trouvés sur des forums ou autre mais les macros ne s'arrêtent jamais de tourner...

Pourriez-vous s'il vous plaît m'aider ? Si ça peut vous aider, je travaille sur Office365

Bonne soirée,

Atmane

bonjour,

Si l'on n'y prend pas garde, ce type d'opération est extrêmement chronovore... Compter au moins une minute pour 100 lignes effectivement supprimées.

Cette macro un peu optimisée met encore 7 minutes chez moi... On peut sans doute faire mieux mébon...

Sub Galopin()
Dim iLR%, i%, Arr
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Arr = [A1].CurrentRegion.Value
iLR = UBound(Arr)
For i = iLR To 2 Step -1
If Arr(i, 19) = "SupprimerLigne" Then Rows(i).Delete
Next
Application.Calculation = xlCalculationAutomatic
End Sub

EDIT : La macro s'exécute sur la feuille active...

A+

Bonjour Atamne, le fil

Une alternative (plus) rapide

Public tabData()
Public tabNouv()

Sub Essai()
Dim cptData
Dim cptNouv
Dim cptCol

    tabData = Range(Cells(2, 1), Cells(LasRow, LastCol))
    cptNouv = 0
    For cptData = 1 To UBound(tabData, 1)
        If Not (tabData(cptData, 19) = "SupprimerLigne") Then
            cptNouv = cptNouv + 1
            ReDim Preserve tabNouv(1 To UBound(tabData, 2), 1 To cptNouv)
            For cptCol = 1 To UBound(tabData, 2)
                If Not (Cells(2, cptCol).HasFormula) Then
                    tabNouv(cptCol, cptNouv) = tabData(cptData, cptCol)
                Else
                    tabNouv(cptCol, cptNouv) = Cells(2, cptCol).Formula
                End If
            Next
        End If
    Next

    Range(Cells(2, 1), Cells(LastRow, LastCol)).ClearContents
    Cells(2, 1).Resize(UBound(tabNouv, 2), UBound(tabNouv, 1)) = Application.Transpose(tabNouv)

End Sub

Function LasRow() As Long
    LasRow = Application.Max(Cells(Rows.Count, 1).End(xlUp).Row, 2)
End Function

Function LastCol() As Long
    LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
End Function

A peine quelques seconde !

Désolé

Une erreur s'est glissée dans mon code

La fonction LasRow doit être corrigée comme cela :

Function LastRow() As Long
    LastRow = Application.Max(Cells(Rows.Count, 1).End(xlUp).Row, 2)
End Function

Bonjour à tous,

Si votre fichier "export....." est un fichier intermédiaire, une solution via Power Query peut s'avérer une piste intéressante.

Bonjour,

Merci @galopin01 pour ta proposition. Effectivement l'idéal serait d'avoir une macro très rapide car elle est destinée à être utilisée par d’autres personnes moins patientes que moi 😊 Si jamais tu as une solution d'optimisation je suis preneur

Merci @greensofts les lignes vides sont bien supprimées, cependant les lignes restantes sont toutes identiques. Quelle est la solution pour bien garder les lignes ?

Merci @JFL pour la proposition. Comme indiqué à Galopin01, cette macro sera utilisée par d’autres personnes qui ne connaissent pas Power Qwery donc la contrainte est de passer par Excel obligatoirement.

Bonne journée à tous les 3 et encore merci

Bonjour de nouveau

......Comme indiqué à Galopin01, cette macro sera utilisée par d’autres personnes qui ne connaissent pas Power Qwery donc la contrainte est de passer par Excel obligatoirement.

Power Query est nativement intégré dans Excel depuis 2016.
Par ailleurs, une fois la requête en place, il faut simplement, si la source évolue, actualiser les données via...... un clic ! Et pour les terriblement impatients, un code léger VBA peut éviter cette lourde tâche....

Je pense que notre ami va corriger son erreur: Le principe me semble bon... même si comme lui je m'y perd un peu !

A+

Bonjour le fil

Je ne comprend pas

les lignes vides sont bien supprimées, cependant les lignes restantes sont toutes identiques. Quelle est la solution pour bien garder les lignes ?

de quelles lignes "restantes" tu parles ?

Edit/

Je viens de comprendre !!!

Dans tes formules tu fais référence à différentes lignes, ma solution ne peut donc pas fonctionner !

Je te laisse envisager les autres solutions proposées

Désolé pour les fausses joies !

Ménon au contraire... Tu étais sur la bonne voie mais tu t'es perdu en chemin !

La macro de Green Soft corrigée : (Désolé j'ai remis à ma sauce mais le mérite t'en revient quand même !)

Option Explicit

Sub Galopin()
Dim cptData&, cptNR&, cptCol&, iLR&, iLC&
Dim rng As Range, Arr(), ArrC()
Set rng = [A1].CurrentRegion
With rng
    Set rng = .Offset(1).Resize(.Rows.Count - 1)
End With
Arr = rng.Value
iLR = UBound(Arr)
iLC = UBound(Arr, 2)
    cptNR = 0
    For cptData = 1 To UBound(Arr, 1)
        If Not (Arr(cptData, 19) = "SupprimerLigne") Then
            cptNR = cptNR + 1
            ReDim Preserve ArrC(1 To UBound(Arr, 2), 1 To cptNR)
            For cptCol = 1 To UBound(Arr, 2)
                If Not (Cells(2, cptCol).HasFormula) Then
                    ArrC(cptCol, cptNR) = Arr(cptData, cptCol)
                Else
                    ArrC(cptCol, cptNR) = Cells(cptData + 1, cptCol).Formula
                End If
            Next
        End If
    Next
    Range(Cells(2, 1), Cells(iLR, iLC)).ClearContents
    Cells(2, 1).Resize(UBound(ArrC, 2), UBound(ArrC, 1)) = Application.Transpose(ArrC)
End Sub

A+

Bonjour à tous!

Un essai comme ceci...

Sub tri()
Dim xrg As Range
dl = Range("S" & Rows.Count).End(xlUp).Row
Range("A2").CurrentRegion.Sort Key1:=Range("S2"), Order1:=xlDescending, Header:=xlYes
For i = 2 To dl
If Cells(i, 19) = "SupprimerLigne" Then
Range(Cells(2, 1), Cells(i, 60)).Select
Set xrg = Range(Cells(2, 1), Cells(i, 60))
End If
Next i
xrg.Delete
End Sub

Bonjour le fil

@galopin01

Merci pour la correction,

Je pensais ne pas avoir pris en compte certaines références à d'autres lignes du tableau, cependant que je ne vois pas ce que tu as corrigé...? Mais j'ai lu, il est vrai ton code à la volée

Mais bref si tu assures que le tien fonctionne, tant mieux pour notre ami Atmane !

(reste à savoir si il valide lui aussi)

Je vous remercie beaucoup beaucoup pour vos propositions, c'est super, cela fonctionne bien.

Vraiment un grand merci pour le temps pris pour m'aider

Il ne me reste plus qu'à me former sur VBA que je ne connais pas du tout. D'ailleurs si vous avez des formations en e-learning à me conseiller, je suis preneur ;)

Bonne soirée à vous

Bonjour Atmane, le fil

Heureux d'avoir contribué à résoudre ton problème


PS/ @galopin01

J'ai compris => Cells(cptData + 1, cptCol).Formula !!!

Rechercher des sujets similaires à "macro supprimer ligne entiere contient valeur"