Suppression lignes selon valeur cellule
Résolu/Fermé
Evedll
Evedll
- Messages postés
- 72
- Date d'inscription
- vendredi 6 juillet 2007
- Statut
- Membre
- Dernière intervention
- 25 octobre 2018
Evedll
- Messages postés
- 72
- Date d'inscription
- vendredi 6 juillet 2007
- Statut
- Membre
- Dernière intervention
- 25 octobre 2018
A voir également:
- Excel vba supprimer ligne selon valeur cellule
- Excel supprimer ligne si cellule contient - Meilleures réponses
- Macro excel supprimer ligne si cellule contient - Meilleures réponses
- Suppression lignes selon valeur cellule ✓ - Forum - VB / VBA
- Supprimer ligne en fonction valeur de cellule ✓ - Forum - Excel
- Macro supprime ligne selon la valeur d'une cellule ✓ - Forum - Excel
- Excel vba supprimer ligne ✓ - Forum - VB / VBA
- Excel changer couleur ligne selon valeur cellule - Guide
3 réponses
jordane45
22 oct. 2018 à 09:24
- Messages postés
- 35502
- Date d'inscription
- mercredi 22 octobre 2003
- Statut
- Modérateur
- Dernière intervention
- 26 mai 2022
22 oct. 2018 à 09:24
Bonjour
Function FindAll(ByVal sText As String, ByRef oRange As Range, ByRef arMatches() As String) As Boolean ' -------------------------------------------------------------------------------------------------------------- ' FindAll - To find all instances of the1 given string and return the row numbers. ' If there are not any matches the function will return false ' -------------------------------------------------------------------------------------------------------------- On Error GoTo Err_Trap Dim rFnd As Range ' Range Object Dim iArr As Integer ' Counter for Array Dim rFirstAddress ' Address of the First Find ' ----------------- ' Clear the Array ' ----------------- Erase arMatches Set rFnd = oRange.Find(what:=sText, LookIn:=xlValues, lookAt:=xlPart) If Not rFnd Is Nothing Then rFirstAddress = rFnd.Address Do Until rFnd Is Nothing iArr = iArr + 1 ReDim Preserve arMatches(iArr) arMatches(iArr) = rFnd.Row 'rFnd.Address pour adresse complete ' rFnd.Row Pour N° de ligne Set rFnd = oRange.FindNext(rFnd) If rFnd.Address = rFirstAddress Then Exit Do ' Do not allow wrapped search Loop FindAll = True Else ' ---------------------- ' No Value is Found ' ---------------------- FindAll = False End If ' ----------------------- ' Error Handling ' ----------------------- Err_Trap: If Err <> 0 Then MsgBox Err.Number & " " & Err.Description, vbInformation, "Find All" Err.Clear FindAll = False Exit Function End If End Function Sub deleteByValue() Dim arMatches() As String Dim valcherch As String Dim Sh As Worksheet Dim rng As Range Set Sh = ThisWorkbook.Sheets("Feuil1") Set rng = Sh.Range("A1:A100") valcherch = "Noé v2017" bFound = FindAll(valcherch, rng, arMatches()) If bFound = True Then nbElemTrouve = UBound(arMatches) For i = 1 To nbElemTrouve Debug.Print (arMatches(i)) 'ici tu peux mettre le code de suppression '... Next End If End Sub
ThauTheme
Modifié le 22 oct. 2018 à 09:44
- Messages postés
- 1438
- Date d'inscription
- mardi 21 octobre 2014
- Statut
- Membre
- Dernière intervention
- 25 mai 2022
Modifié le 22 oct. 2018 à 09:44
Bonjour Evelyne, bonjour le forum,
Peut-être comme ça (nom de l'onglet à adapter) :
[Édition]
Bonjour jordane, nos post se sont croisés...
À plus,
ThauTheme
Peut-être comme ça (nom de l'onglet à adapter) :
Sub Macro1() Dim O As Worksheet 'déclare la variable O (Onglet) Dim DL As Integer 'déclare la variable DL (Dernière Ligne) Dim I As Integer 'déclare la variable I (Incrément) Dim J As Integer 'déclare la variable J (incrément) Dim BET As Variant 'déclare la variable BET (Boîte d'Entrée Texte) Dim BEL As Integer 'déclare la variable BEL (Boîte d'Entrée Ligne) Application.ScreenUpdating = False 'masque les raffraîchissements d'écran Set O = Worksheets("Feuil1") 'définit l'onglet O (à adapter à ton cas) DL = O.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet O BET = Application.InputBox("Taper le texte à rechercher.", "RECHERCHE", Type:=2) 'définit la boîte d'entrée BET qui va définir le texte de la recherche If BET = False Or BET = "" Then Exit Sub 'si bouton [Annuler] ou non renseignée, sort de la procédure BEL = Application.InputBox("Supprimer combien de lignes", "SUPRESSION", Type:=1) 'définit la boîte d'entrée BEL qui va définir le nombre de lignes à supprimer If BEL = False Or BEL = 0 Or BEL > Application.Rows.Count Then Exit Sub 'si bouton [Annuler] ou non renseignée ou nombre trop grand, sort de la procédure J = 1 'initialise la variable J For I = DL To 1 Step -1 'boucle 1 : inversée des lignes DL à la ligne 1 en remontant If O.Cells(I, "A").Value = BET Then 'condition : si la cellule en colonne A de la boucle vaut BET O.Rows(I).Delete 'supprime la ligne J = J + 1 'incrémente J If J > BEL Then Exit Sub 'si J est supérieur à BEL, sort de la procédure End If 'fin de la condition Next I 'prochaine ligne de la boucle 1 End Sub
[Édition]
Bonjour jordane, nos post se sont croisés...
À plus,
ThauTheme
Evedll
22 oct. 2018 à 18:32
- Messages postés
- 72
- Date d'inscription
- vendredi 6 juillet 2007
- Statut
- Membre
- Dernière intervention
- 25 octobre 2018
22 oct. 2018 à 18:32
Bonjour ThauTheme,
Merci de ton aide.
Je vais tester et analyser pour comprendre et te donnerai mon résultat dès que possible.
J'ai vu que tu as bien expliqué chaque ligne et ça devrait m'aider pas mal.
A bientôt
Evelyne
Merci de ton aide.
Je vais tester et analyser pour comprendre et te donnerai mon résultat dès que possible.
J'ai vu que tu as bien expliqué chaque ligne et ça devrait m'aider pas mal.
A bientôt
Evelyne
Evedll
22 oct. 2018 à 19:48
- Messages postés
- 72
- Date d'inscription
- vendredi 6 juillet 2007
- Statut
- Membre
- Dernière intervention
- 25 octobre 2018
22 oct. 2018 à 19:48
Hello,
J'ai essayé tes lignes de commandes. Je vois bien apparaitre les boites de dialogues dans lesquelles je saisis mes données. Par contre, cela ne supprime qu'une ligne (avec la valeur Noé...) sans les 6 lignes qui suivent cette donnée et pas dans la totalité de ma feuille. Voici le lien de mon fichier. J'ai modifié les coordonnées pour la protection des données mais j'ai laissé le plus important. Pour que tu puisses voir ce qu'il faut supprimer, j'ai mis les lignes en couleur. Ce fichier est un des plus petits que j'ai. J'ai essayé de voir où était le problème mais je ne vois pas. Merci si tu peux m'aider.
https://we.tl/t-QvBe1r9C99
Bien cordialement
Evelyne
J'ai essayé tes lignes de commandes. Je vois bien apparaitre les boites de dialogues dans lesquelles je saisis mes données. Par contre, cela ne supprime qu'une ligne (avec la valeur Noé...) sans les 6 lignes qui suivent cette donnée et pas dans la totalité de ma feuille. Voici le lien de mon fichier. J'ai modifié les coordonnées pour la protection des données mais j'ai laissé le plus important. Pour que tu puisses voir ce qu'il faut supprimer, j'ai mis les lignes en couleur. Ce fichier est un des plus petits que j'ai. J'ai essayé de voir où était le problème mais je ne vois pas. Merci si tu peux m'aider.
https://we.tl/t-QvBe1r9C99
Bien cordialement
Evelyne
ThauTheme
Modifié le 22 oct. 2018 à 20:34
- Messages postés
- 1438
- Date d'inscription
- mardi 21 octobre 2014
- Statut
- Membre
- Dernière intervention
- 25 mai 2022
Modifié le 22 oct. 2018 à 20:34
Re,
Ça ne pouvait pas marcher !... Je navet (si, si, dans ce cas on peut...) pas vu les choses comme ça. Rien ne vaut un fichier exemple !
Le code modifié. Pour l'instant il ne fait que sélectionner. Teste le et s'il convient, remplace la dernière ligne : PL.Select par PL.Delete.
Le code :
À plus,
ThauTheme
Ça ne pouvait pas marcher !... Je navet (si, si, dans ce cas on peut...) pas vu les choses comme ça. Rien ne vaut un fichier exemple !
Le code modifié. Pour l'instant il ne fait que sélectionner. Teste le et s'il convient, remplace la dernière ligne : PL.Select par PL.Delete.
Le code :
Sub Macro1() Dim O As Worksheet 'déclare la variable O (Onglet) Dim DL As Integer 'déclare la variable DL (Dernière Ligne) Dim TV As Variant 'déclare la variable TV (Tableau des valeurs) Dim PL As Range 'déclare la variable PL Dim I As Integer 'déclare la variable I (Incrément) Dim BET As Variant 'déclare la variable BET (Boîte d'Entrée Texte) Dim BEL As Integer 'déclare la variable BEL (Boîte d'Entrée Ligne) Dim LD As Long 'déclare la variable LD (Ligne de Début) Dim LF As Long 'déclare la variable LF (Ligne de Fin) Set O = Worksheets("Feuil1") 'définit l'onglet O (à adapter à ton cas) DL = O.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet O TV = O.Range("A1:A" & DL) 'définit le tableau des valeurs TV Set PL = O.Range("A1") 'initialise la plage PL BET = Application.InputBox("Taper le début du texte à rechercher.", "RECHERCHE", Type:=2) 'définit la boîte d'entrée BET qui va définir le texte de la recherche If BET = False Or BET = "" Then Exit Sub 'si bouton [Annuler] ou non renseignée, sort de la procédure For I = DL To 1 Step -1 'boucle inversée sur toutes les lignes I de la dernière DL à la première If UCase(TV(I, 1)) Like UCase(BET) & "*" Then 'si BET (convertie en majuscule) correspond au début du texte recherche (en majuscule aussi) LD = I 'définit la ligne de début LD 'définit la ligne de fin LF (DL si LD = DL, sinon la première ligne, après la ligne de début LD, contenant le texte "Chèque Accueil" LF = IIf(LD = DL, I, O.Columns(1).Find("Chèque Accueil", O.Cells(LD, "A"), xlValues, xlWhole).Row) 'définit la plage PL (les ligne de LD a LF ai PL ne contient qu'une seule cellule, sinon l'union de la plage PL et des ligne LD à LF Set PL = IIf(PL.Cells.Count = 1, O.Rows(LD & ":" & LF), Application.Union(PL, O.Rows(LD & ":" & LF))) End If 'fin de la condition Next I 'prochaine ligne de la boucle PL.Select 'ligne à remplacer par [PL.Delete] quand les tests sont concluants End Sub
À plus,
ThauTheme
Evedll
22 oct. 2018 à 23:08
- Messages postés
- 72
- Date d'inscription
- vendredi 6 juillet 2007
- Statut
- Membre
- Dernière intervention
- 25 octobre 2018
22 oct. 2018 à 23:08
SUPER !!!!!
Alors là, ça me coupe le souffle ! ça fait des jours que je cherche à comprendre comment pouvoir faire et même avec ce que tu m'as donné en début, je n'ai pas su corriger moi même. Et toi, en une demi heure c'est fait.
UN GRAND MERCI.
J'ai encore beaucoup à travailler sur ces fichiers et j'en ai beaucoup, et pour certains bien plus grand que celui là et j'essaie de trouver seule au maximum mais je galère. Sans formation ou sans aide, c'est très compliqué.
C'est agréable de se savoir soutenue.
Cordialement
Evelyne
Alors là, ça me coupe le souffle ! ça fait des jours que je cherche à comprendre comment pouvoir faire et même avec ce que tu m'as donné en début, je n'ai pas su corriger moi même. Et toi, en une demi heure c'est fait.
UN GRAND MERCI.
J'ai encore beaucoup à travailler sur ces fichiers et j'en ai beaucoup, et pour certains bien plus grand que celui là et j'essaie de trouver seule au maximum mais je galère. Sans formation ou sans aide, c'est très compliqué.
C'est agréable de se savoir soutenue.
Cordialement
Evelyne
22 oct. 2018 à 10:35
Je viens de voir que le miens pourrait te causer des difficultés....
En effet, il faudra faire la boucle en partant de la fin (comme dans l'exemple de ThauTheme ) cas sinon les Numéros de lignes ne seront plus les bons au fur et à mesure que tu les supprimera )
22 oct. 2018 à 18:27
Oui j'ai essayé ce matin avec un peu de mal. Je vais donc voir celui de ThauTheme.
Cependant, je te remercie beaucoup de m'aider car je n'ai jamais appris et c'est difficile seule mais je progresse avec l'aide de vous tous.
Cordialement
Evelyne
22 oct. 2018 à 20:15