Supprimer lignes VBA avec plusieurs conditions
Bonjour,
Je dispose d'un tableau Excel avec en colonne A, des informations inutiles que je voudrais supprimer. Cependant j'ai plusieurs conditions:
Je dois supprimer les lignes jusqu'a ce que la cellule A1 contienne la valeur "Ac"
Je dois supprimer toutes les lignes dont la valeur de la colonne A n'est pas "D", "K" ou "S".
J'ai pour cela ecrit deux macros differentes:
Dim i as Integer
For i = Range("A") & Rows.count).End(xlUp).Row to 1 step -1
If cells (i,1).Text<>"Ac" Then Rows(i).Delete
Next i
Ainsi que:
Dim i as integer
For i = Range("A") & Rows.count).End(xlUp).Row to 2 step -1
If Range("A" & i).Value <> "K" And Range("A" & i).Value <> "D" And Range("A" & i).Value <> "S" Then Rows(i).Delete
Next i
Les deux macros fonctionnent separement, mais j'aimerais les combines pour que:
dans la ligne 1 j'obtienne ma ligne avec "Ac" dans la cellule A1 et qu'en dessous de cette ligne se trouvent toutes les autres qui contiennent "D", "K" ou "S" dans la colonne A.
Merci de votre aide !
Bonjour,
Si les 2 fonctionnent séparément et que tu souhaites n'avoir qu'une exécution, pourquoi ne pas mettre ton code à la suite ?
Bonjour!
Car malheureusement la deuxieme partie du code n’est pas prise en compte étant donné que dans la première j’ai demandé à supprimer toutes les lignes qui ne contenaient pas “Ac” dans la colonne A...
Bonjour,
Merci de joindre un fichier pour illustrer tes propos.
Cdlt.
Test avec ça :
Dim i as Integer, Max As Integer
i = 1
Max = Range("A") & Rows.count).End(xlUp).Row
While i <= Max
If cells (i,1).Text="Ac" Then
Rows(1:i-1).Delete
i = Max
Else: i = i + 1
End If
Wend
For i = Range("A") & Rows.count).End(xlUp).Row to 2 step -1
If Range("A" & i).Value <> "K" And Range("A" & i).Value <> "D" And Range("A" & i).Value <> "S" Then Rows(i).Delete
Next iBonjour,
Le problème vient de la première boucle :
"Je dois supprimer les lignes jusqu'a ce que la cellule A1 contienne la valeur "Ac""
Le soucis :
Dim i as Integer
For i = Range("A") & Rows.count).End(xlUp).Row to 1 step -1
If cells (i,1).Text<>"Ac" Then Rows(i).Delete
Next itu t'arrêtes seulement une fois que tu as parcouru toutes tes lignes, si tu veux arrêter ta boucle dès que tu trouves Ac il faudra faire comme suit :
Dim i as Integer
For i = Range("A") & Rows.count).End(xlUp).Row to 1 step -1
If cells (i,1).Text<>"Ac" Then Rows(i).Delete
else exit for
Next ic'est plus simple que ce que je propose
Bonjour,
Le problème vient de la première boucle :
"Je dois supprimer les lignes jusqu'a ce que la cellule A1 contienne la valeur "Ac""
Le soucis :
Dim i as Integer For i = Range("A") & Rows.count).End(xlUp).Row to 1 step -1 If cells (i,1).Text<>"Ac" Then Rows(i).Delete Next itu t'arrêtes seulement une fois que tu as parcouru toutes tes lignes, si tu veux arrêter ta boucle dès que tu trouves Ac il faudra faire comme suit :
Dim i as Integer For i = Range("A") & Rows.count).End(xlUp).Row to 1 step -1 If cells (i,1).Text<>"Ac" Then Rows(i).Delete else exit for Next i
Bonjour a tous !
Merci pour vos suggestions, mais aucune d'entre elles ne marchent, la ligne contenant "Ac" se supprime egalement, et je ne sais pas pourquoi...
Vous trouverez en piece jointe un exemple de ce que je souhaiterais. Feuille "ORIGINAL" = le fichier extrait, feuille "WANTED" = ce que j'aimerais obtenir.
Merci de votre aide en tous cas !
Re,
Comme quoi, un petit fichier est nécessaire !...
Cdlt.
Public Sub XXX()
Dim n As Long, lRow As Long, i As Long
With ActiveSheet
On Error Resume Next
n = Application.Match("Ac", .Columns(1), 0)
If Err.Number = 0 Then
Application.ScreenUpdating = False
.Cells(1).Resize(n - 1).EntireRow.Delete
lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = lRow To 2 Step -1
Select Case .Cells(i, 1).Value
Case "D", "K", "S":
Case Else: .Rows(i).Delete shift:=xlUp
End Select
Next i
End If
End With
End SubMerci beaucoupppppppppp !!!!
Re,
Comme quoi, un petit fichier est nécessaire !...
Cdlt.
anais02.xlsm
Public Sub XXX() Dim n As Long, lRow As Long, i As Long With ActiveSheet On Error Resume Next n = Application.Match("Ac", .Columns(1), 0) If Err.Number = 0 Then Application.ScreenUpdating = False .Cells(1).Resize(n - 1).EntireRow.Delete lRow = .Cells(.Rows.Count, 1).End(xlUp).Row For i = lRow To 2 Step -1 Select Case .Cells(i, 1).Value Case "D", "K", "S": Case Else: .Rows(i).Delete shift:=xlUp End Select Next i End If End With End Sub
Bon eh bien merci tu m'auras appris de nouvelles choses en VBA... donc If Err.Number = 0 pour dire si on a pas d'erreur... Match pour savoir quand est-ce qu'on trouve Ac... et Resize pour redefinir la plage.... Eh ben...
Bonjour,
@ Ausecour,
Et même pas un petit coeur !...
Tu ne m'aimes pas…
Bonne journée.
Cdlt.
Euh non désolé pas de petits coeurs, par contre ton message m'a fait pensé à autre chose, parce que je dois avouer que je suis complètement débutant en gestión d'erreur par codage... Il m'est arrivé de mettre
On error Resume NextPour passer à la ligne suivant en cas d'erreur, mais pour remettre tout en état, c'est bien
On error Goto 0qu'il faut mettre?
Parce qu'à la vue de ton code je commence à douter comme tu contrôles qu'une erreur renvoie 0... à moins que ce soit un code d'erreur renvoyé par le compilateur...
Bonjour Ausecour, le forum,
On Error Resume Next : avec cette instruction, quand une erreur se produit : au lieu de planter, ça saute la ligne qui a causé l'erreur et ça passe à la suivante ; On Error GoTo 0 annule l'instruction On Error Resume Next ; donc si une erreur s'produit de nouveau : plantage ; si tu veux, c'est comme un trapéziste à qui on a retiré le filet de protection !
dhany
Re,
Pour information, la procédure modifiée pour une meilleure compréhension :
Option Explicit
Public Sub XXX()
Dim n As Long, lRow As Long, i As Long
With ActiveSheet
On Error Resume Next
n = Application.Match("Ac", .Columns(1), 0)
If Err.Number = 0 Then
'code...
Else
MsgBox "Ac n'existe pas !...", 64, "Information"
'On error goto 0
Err.Clear
End If
End With
End SubBonjourJean-Eric et dhany!
Merci à vous 2 pour vos réponses