Supprimer nbr lignes EXCEL VBA
sheebie23
-
eriiic Messages postés 24581 Date d'inscription Statut Contributeur Dernière intervention -
eriiic Messages postés 24581 Date d'inscription Statut Contributeur Dernière intervention -
Bonjour,
J'ai un fichier excel qui se présente comme suit, sur beaucoup plus de lignes:
A1 blablablablabalablabla B1 ATP
A2 blablablablabla
A3 blabalbalbalblabal
A4 balbalbalbalbalballbblbla
A5
A6 blablablabalblabalbal B6 AAA
A7 blablablabalbal
A8 balbalbal
A9
A10 blabalbalbalbalblbalbalbal B10 ATP
A11 balbalbalbalbalbalbla
A12 balbalbalbalblabalbal
etc
etc
Et je voudrais que si la cellule en B contient ATP, supprimer toutes les lignes jusqu'à la ligne vide.
Puis refaire le test sur la ligne suivante.
Merci pour votre aide
J'ai un fichier excel qui se présente comme suit, sur beaucoup plus de lignes:
A1 blablablablabalablabla B1 ATP
A2 blablablablabla
A3 blabalbalbalblabal
A4 balbalbalbalbalballbblbla
A5
A6 blablablabalblabalbal B6 AAA
A7 blablablabalbal
A8 balbalbal
A9
A10 blabalbalbalbalblbalbalbal B10 ATP
A11 balbalbalbalbalbalbla
A12 balbalbalbalblabalbal
etc
etc
Et je voudrais que si la cellule en B contient ATP, supprimer toutes les lignes jusqu'à la ligne vide.
Puis refaire le test sur la ligne suivante.
Merci pour votre aide
6 réponses
-
Bonjour tout le monde,
Une autre proposition :Sub suppLig() Dim c As Range Set c = [B:B].Find("ATP", LookIn:=xlValues) While Not c Is Nothing Cells(c.Row, 1).Resize(Cells(c.Row, 1).End(xlDown).Row - c.Row + 2, 1).EntireRow.Delete Set c = [B:B].Find("ATP", LookIn:=xlValues) Wend End Sub
eric -
Bonjour Eric et Melanie,
Merci pour votre aide,
J'avoue que je ne comprends pas trop vos macro mais c'est celle d'Eric qui fonctionne le mieux pour mon tableau.
Si maintenant je veux dire q si la date en C est inférieure à la date du jour en D2 ET B="APT" est ce que je peux faire comme ça :
Sub suppLig()
Dim c As Range
Dim d As RAnge
Dim e As Range
Set c = [B:B].Find("ATP", LookIn:=xlValues)
Set d = [C:C]
Set e =[D2]
If While Not c Is Nothing and d<e then
Cells(c.Row, 1).Resize(Cells(c.Row, 1).End(xlDown).Row - c.Row + 2, 1).EntireRow.Delete
Set c = [B:B].Find("ATP", LookIn:=xlValues)
Wend
End If
End Sub
Je suis encore une quiche en macro et j'ai du mal à comprendre Dim As Range et compagnie alors si vous pourriez m'expliquer un peu par la même occasion ce serait sympa.
Sheebie -
Vraiment désolée de vous embrouiller comme ça. Je me suis trompée.
En fait je voudrais juste q si la date en C est antérieure à la date du jour, supprimer le paragraphe.
Merci pour votre compréhension -
Bonjour,
Réfléchi bien encore un peu et lorsque tu seras sûre repose la question complète
eric -
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question -
Bonjour,
J'ai bien réfléchi et j'ai donc besoin de faire la chose suivante :
Avec un tableau de la forme :
A1 blablablablabalablabla B1 date 1 C1 date du jour + heure
A2 blablablablabla
A3 blabalbalbalblabal
A4 balbalbalbalbalballbblbla
A5
A6 blablablabalblabalbal B6 date 2
Je voudrais supprimer le paragraphe si la date en B est antérieure à la date du jour.
Merci d'avance pour votre aide-
Bonsoir,
Comme tu ne l'as pas précisé j'ai supposé qu'en B il n'y avait que la date et qu'il ne fallait donc pas tenir compte de l'heure.
Je me sers quand même de C1, bien que ce soit inutile si c'est réellement la date du jour en cours (on peut le mettre en dur dans le code)
Essaie avec ça :Sub supprimeLignes() Dim lig As Long, dateMax As Date, r dateMax = Int([C1]) Application.ScreenUpdating = False For lig = [B65536].End(xlUp).Row To 1 Step -1 If IsDate(Cells(lig, 2)) And Cells(lig, 2) < dateMax Then Cells(lig, 1).Resize(Cells(lig, 1).End(xlDown).Row - lig + 1, 1).EntireRow.Delete End If Next lig Application.ScreenUpdating = True End Sub
eric
-
-
bonjour,
via une macro
sub suppression ()
i=1
cells(i,60).select
ActiveCell.FormulaR1C1 = "=SEARCH(""atp"",RC[-2],1)"
selection.copy
range(cells(i,60),cells(19999,60)).select
activesheet.paste
do while i < 20000 'fonctionnera jusqu'à la 20000eme lignes
if iserror(cells(i,60) then
cells(i,60) =""
i=i+1
else
a=i
do while cells(i,2)<>""
i=i+1
loop
range(rows(a),rows(i)).select
Selection.Delete Shift:=xlUp
end if
loop
end sub
