Supprimer nbr lignes EXCEL VBA
sheebie23
-
eriiic Messages postés 25847 Date d'inscription Statut Contributeur Dernière intervention -
eriiic Messages postés 25847 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
A voir également:
- Supprimer nbr lignes EXCEL VBA
- Supprimer rond bleu whatsapp - Guide
- Liste déroulante excel - Guide
- Supprimer page word - Guide
- Word et excel gratuit - Guide
- Si ou excel - Guide
6 réponses
Bonjour tout le monde,
Une autre proposition :
eric
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
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
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
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
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 :
eric
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
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
