Supprimer lignes qui contiennent la valeur de la cellule sélectionnée
Bonjour,
Actuellement, j'ai un code qui me permet de supprimer la ligne sélectionnée dans mon tableau, feuille "STOCK"
Et je voudrais que ça supprime également les entrées et les sorties qui ont le même code que celui que je supprime.
Par exemple, dans ma feuille "STOCK", je sélectionne ma ligne qui a le code 0A-11, je la supprime avec la poubelle.
Je souhaiterais qu'il aille aussi rechercher dans les feuilles "ENTREE" et "SORTIE" s'il retrouve la valeur 0A-11 dans les colonnes correspondantes (colonne F pour la feuille "ENTREE" et H pour la feuille "SORTIE") . Et s'il en existe, supprimer également les lignes du tableau(et non de la feuille) qui contiennent cette valeur.
Merci beaucoup !
Bonjour
Vous avez protégé vos feuilles ENTREE et SORTIE. Quel est le mot de passe que je vérifie le code que je vais vous proposer ?
Cordialement
Bonjour Dan !
Autant pour moi, c'est "stock"
la feuille se protège après chaque entrée ou sortie , oublié de le retirer.
Merci
Celui-ci ne devrait pas avoir d'erreur si jamais
Re
Ok merci mais je venais de le trouver par la variable PSW...
Attention que vous avez deux fois la macro Supprimer dans le fichier. Une fois dans la feuille Stock et une dans le module1
De mon coté, j'évite toujours de mettre des sub dans les feuilles voire de minimiser les codes dans les feuilles. Dans votre cas faites ceci :
- supprimer la macro Supprimer ligne qui se trouve dans la feuille stock
- dans votre module, remplacer la macro Supprimer lignes par celle ci-dessous :
'//BOUTON SUPPRIMER LIGNE DU TABLEAU SELECTIONNE
Sub supprimer_ligne()
Dim Code As String
Dim lo As ListObject, lr As ListRow, lRowInTable As Long
If Not ActiveCell.ListObject Is Nothing Then
msg = "Supprimer cette ligne " & ActiveCell.Row & " ?"
Style = vbYesNo + vbCritical + vbDefaultButton2
Title = "Suppression"
Response = MsgBox(msg, Style, Title)
If Response = vbYes Then
Set lo = ActiveCell.ListObject
lRowInTable = ActiveCell.Row - lo.HeaderRowRange.Row
Code = lo.DataBodyRange.Item(lRowInTable, 7)
Set lr = lo.ListRows(lRowInTable)
lr.Range.Delete
With Feuil5.ListObjects("Tabentree") 'feuille ENTREE
On Error Resume Next
Lig = .DataBodyRange.Find(Code, LookIn:=xlValues, Lookat:=xlWhole).Row - 16
If Lig > 0 Then
Feuil5.Unprotect PSW
.ListRows(Lig).Range.Delete
Lig = 0
Feuil5.Protect PSW
End If
End With
With Feuil3.ListObjects("Tabsortie") 'Feuille SORTIE
Lig = .DataBodyRange.Find(Code, LookIn:=xlValues, Lookat:=xlWhole).Row - 16
If Lig > 0 Then
Feuil3.Unprotect PSW
.ListRows(Lig).Range.Delete
Lig = 0
Feuil3.Protect PSW
End If
End With
End If
Else
Exit Sub
End If
End SubJ'ai apporté les changements suivants :
- rajouté une variable Code
- rajouté la n° de ligne sélectionnée dans la variable "msg" pour que ce soit précisé dans le message
- rajouté les lignes de code pour la suppression demandée (feuille Entree et Sortie) en dessous de la ligne "lr.Range.Delete
Cordialement
Oui, en fait je l'avais 2 fois, celle d'en le module1 était en public car je l'utilise sur les autres feuilles.
J'avais dupliqué le code dans la feuille stock pour le modifié par après., mais peu importe.
Cela fonctionne bien mais à première vue, il ne retire qu'une seule ligne, que ça soit dans ENTREE ou SORTIE, alors qu'il peut y en avoir plusieurs.
Merci !
Cela fonctionne bien mais à première vue, il ne retire qu'une seule ligne, que ça soit dans ENTREE ou SORTIE, alors qu'il peut y en avoir plusieurs.
Ah ok là c'est plus complexe.
Donc une seule ligne dans stock mais plusieurs lignes dans Entrée et Sortie ?
Oui, en fait je l'avais 2 fois, celle d'en le module1 était en public car je l'utilise sur les autres feuilles
Ok. Le mieux est de n'en faire qu'une seule mais cela reste à voir
Ah ok là c'est plus complexe.
Ca l'est déjà bien assez pour moi
Petite question, combien pensez-vous avoir de lignes de données dans les feuilles Entree et Sortie
Si à chaque fin d'année j'exporte les entrées et sorties sur un autre fichier et que je remet à 0 les tableaux, je dirais pour prendre un peu large 2000 entrées et..peut-être 20000 sorties. Franchement très difficile à prévoir, et puis rien pour le moment me dis que je remettrai les tableaux à 0 chaque année. Si je peux cumuler les entrées et sorties sur 5 ans admettons, avant d'exporter ça serait top.
Bonjour
Merci des infos. Là il y a pas mal de données à traiter éventuellement. Faites ceci :
1. Dans le code Private Sub Worksheet_SelectionChange(ByVal Target As Range) qui se trouve dans les feuilles ENTREE et STOCK, ajoutez cette ligne
If Target.Count > 1 Then Exit Sub2. Dans le module 1, remplacez la macro Supprimer que je vous avais donnée par celle ci-dessous
'//BOUTON SUPPRIMER LIGNE DU TABLEAU SELECTIONNE
Sub supprimer_ligne()
Dim Code As String
Dim lo As ListObject, lr As ListRow, lRowInTable As Long
If Not ActiveCell.ListObject Is Nothing Then
msg = "Supprimer cette ligne " & ActiveCell.Row & "?"
Style = vbYesNo + vbCritical + vbDefaultButton2
Title = "Suppression"
Response = MsgBox(msg, Style, Title)
If Response = vbYes Then
Set lo = ActiveCell.ListObject
lRowInTable = ActiveCell.Row - lo.HeaderRowRange.Row
Code = lo.DataBodyRange.Item(lRowInTable, 7)
Set lr = lo.ListRows(lRowInTable)
lr.Range.Delete
Dim c As Range, Rng As Range
Dim firstaddress As String
Dim lig As Long
Dim Feuille
Dim i As Byte, j As Byte
Feuille = Array(Feuil3, Feuil5)
For i = 0 To UBound(Feuille)
With Feuille(i).ListObjects("TAB" & Feuille(i).Name)
Feuille(i).Unprotect PSW
Set c = .DataBodyRange.Find(Code, LookIn:=xlValues)
If Not c Is Nothing Then
firstaddress = c.Address
Do
lig = Range(c.Address).Row - 16
.ListRows(lig).Range.ClearContents
j = j + 1
Set c = .DataBodyRange.FindNext(c)
On Error Resume Next
Loop While Not c Is Nothing And c.Address <> firstaddress '--> Dan
Set Rng = .DataBodyRange.SpecialCells(xlCellTypeBlanks)
If j = 1 Then
.ListRows(lig).Range.Delete: j = 0
Else: Rng.Delete
End If
End If
Feuille(i).Protect PSW
End With
Next i
End If
End IfCordialement
Bonsoir Dan,
Toutes les données du code se suppriment bien dans les 2 tableaux, par contre dans le tableau des sorties, ça agit plus comme "effacer le contenu" car le tableau ne se réduit pas.
Egalement, ça me fait une erreur avec ce code ci qui se trouve dans la feuille sortie.
'//AFFICHE LA REMARQUE SI "X" SELECTIONNE DANS LES SORTIES
i = Target.Offset(, 1)
If Target.Column = 13 Then
Target.Offset(, 1).Select <======== l'erreur
If Selection <> "" Then
MsgBox i, , "Remarque"
Else
Exit Sub
End If
End IfEn retirant ce code, le tableau ne supprime pas les lignes non plus.
Et pourquoi ne dois-je pas ajouter cette ligne dans la feuille SORTIE également ?
If Target.Count > 1 Then Exit SubMerci à toi !!
Bonjour
Et pourquoi ne dois-je pas ajouter cette ligne dans la feuille SORTIE également ?
Ben en fait, je me suis trompé. C'est dans les feuilles ENTREE et SORTIE que vous devez ajouter la ligne.
Après l'erreur ne devrait plus se produire.
Bonjour,
Plus d'erreur avec le petit code mais le tableau sortie ne s'est pas réduit non plus. La colonne N qui est masquée peut poser ce problème ?
La colonne N qui est masquée peut poser ce problème ?
Non car la colonne N fait partie du tableau structuré et le code utilise ce nom pour la suppression de la ligne.
Mais bizarre je n'ai pas ce souci avec votre fichier. Essayez avec celui-ci
Toujours pareil
J'ai eu aussi ce souci sur cette feuille. Mais le problème a été résolu en ajoutant la variable j
Je ne comprends pas que vous ayez le problème avec le fichier que je viens de vous poster sachant que cela fonctionne chez moi
Dans mon fichier posté, dites-moi quelle ligne vous supprimez et si vous partez bien de la feuille Stock pour la sélection
Edit : pour le code que je vous ai proposé vous devez toujours partir de la feuille STOCK
Oui je supprime toujours depuis la feuille stock puisque j'ai mis la macro sur la "poubelle"
j'avais commencé par supprimer la ligne 18, "TEST2". J'ai essayé les autres également par après aussi.
EDIT : Autant pour moi, en commençant par supprimer "TEST2" , ça fonctionne mais si je supprime "TEST3", qui sont les 2 dernières lignes dans le tableau de sortie, alors la les lignes restent.
J'ai trouvé le souci. En fait le code voyait des cellules vides dans des lignes non concernées par la suppression de la ligne.
Essayez comme ceci
'//BOUTON SUPPRIMER LIGNE DU TABLEAU SELECTIONNE
Sub supprimer_ligne()
Dim Code As String
Dim lo As ListObject, lr As ListRow, lRowInTable As Long
If Not ActiveCell.ListObject Is Nothing Then
msg = "Supprimer cette ligne " & ActiveCell.Row & "?"
Style = vbYesNo + vbCritical + vbDefaultButton2
Title = "Suppression"
Response = MsgBox(msg, Style, Title)
If Response = vbYes Then
Set lo = ActiveCell.ListObject
lRowInTable = ActiveCell.Row - lo.HeaderRowRange.Row
Code = lo.DataBodyRange.Item(lRowInTable, 7)
Set lr = lo.ListRows(lRowInTable)
lr.Range.Delete
Dim c As Range
Dim firstaddress As String
Dim lig As Long
Dim Feuille
Dim i As Byte
Feuille = Array(Feuil3, Feuil5)
For i = 0 To UBound(Feuille)
With Feuille(i).ListObjects("TAB" & Feuille(i).Name)
Feuille(i).Unprotect PSW
Do
Set c = .DataBodyRange.Find(Code, LookIn:=xlValues)
If Not c Is Nothing Then
lig = Range(c.Address).Row - 16
.ListRows(lig).Range.Delete
End If
Loop While Not c Is Nothing
Feuille(i).Protect PSW
End With
Next i
End If
End If
End SubDésolé pour ne pas avoir vu cela
Crdlt
Aucun problème, je tentais de trouver la petite erreur de mon côté mais bon..un peu comme si j'essayais de traduire du mandarin
Ca fonctionne à merveille, un très grand merci pour tout ton taff !
Bonjour Dan,
Il ne me semblait pas avoir l'erreur avant ou alors j'avais oublié d'essayer mais j'ai une erreur qui se produit quand je supprime un article qui n'a ni sortie ni entrée.
Sur la ligne :
Set c = .DataBodyRange.Find(code, LookIn:=xlValues)Variable objet ou variable du bloc With non définie.
'//SUPPRIMER LIGNE PRODUIT + ENTREES + SORTIES
Sub supprimer_ligne_produit_stock()
Dim code As String
Dim lo As ListObject, lr As ListRow, lRowInTable As Long
Application.ScreenUpdating = False
If Not ActiveCell.ListObject Is Nothing Then
msg = "Supprimer le code suivant : " & Range("H" & ActiveCell.Row) & " ?"
Style = vbYesNo + vbCritical + vbDefaultButton2
Title = "Suppression"
Response = MsgBox(msg, Style, Title)
If Response = vbYes Then
Set lo = ActiveCell.ListObject
lRowInTable = ActiveCell.Row - lo.HeaderRowRange.Row
code = lo.DataBodyRange.Item(lRowInTable, 7)
Set lr = lo.ListRows(lRowInTable)
lr.Range.Delete
Dim c As Range
Dim firstaddress As String
Dim lig As Long
Dim Feuille
Dim i As Byte
Feuille = Array(Feuil3, Feuil5)
For i = 0 To UBound(Feuille)
With Feuille(i).ListObjects("TAB" & Feuille(i).Name)
Feuille(i).Unprotect PSW
Do
==============> Set c = .DataBodyRange.Find(code, LookIn:=xlValues)
If Not c Is Nothing Then
lig = Range(c.Address).Row - 16
.ListRows(lig).Range.Delete
End If
Loop While Not c Is Nothing
Feuille(i).Protect PSW
End With
Next i
End If
End If
Application.ScreenUpdating = True
Worksheets("STOCK").Activate
End SubSais-tu pourquoi ?
Merci,