Suppression de ligne si une cellule = 0

steph_gdp Messages postés 35 Statut Membre -
michel_m Messages postés 18903 Date d'inscription Statut Contributeur Dernière intervention - 8 févr. 2013 à 08:08

Bonjour,

Je cherche à faire ceci:

si M2=0 alors supprimer ligne 11
si N2=0 alors supprimer ligne 12
si O2=0 alors supprimer ligne 13
si P2=0 alors supprimer ligne 14
....
etc jusqu'a :

si AC2=0 alors supprimer ligne 27

soit 17 suppression de ligne possible sur un bouton macro

Quelqu'un serait t'il succeptible de réaliser cela pour moi?

Merci

Afficher la suite

4 réponses

Réponse 1 / 4
via55 Messages postés 14393 Date d'inscription Statut Membre Dernière intervention 2 759

Bonjour

Alt F11 pour ouverture editeur VBA
Insertion
Module
Dans le module mettre le code suivant

Sub Efface()

For n = 1 To 17
y = n + 12
x = n + 10

If Cells(2, y) = 0 Then
Rows(x).Select
Selection.Delete Shift:=xlUp

End If

Next n
End Sub

Fermer l'éditeur

Créer le bouton et mettre dans son code le nom de la macro

Cdlmnt
1
1. chossette9 Messages postés 6855 Date d'inscription Statut Contributeur Dernière intervention 1 313
  
  Bonjour,
  
  les macros de suppression de lignes nécessitent une boucle à l'envers, en partant de la dernière ligne vers la première, afin de ne pas louper des lignes entre deux.
  Il vaudrait mieux donc faire
  For n = 17 To 1 Step -1
  Cordialement.
  
  0
2. steph_gdp Messages postés 35 Statut Membre 1
  
  merci de votre collaboration, en effet je pense qu'il faut commencer par la derniere ligne, mais ca me supprime pas les bonnes lignes.
  Y'a t'il autre chose a remplacer mise a part For n = 17 To 1 Step -1 en reprenant la programmation de via55?
  merci
  
  0
3. via55 Messages postés 14393 Date d'inscription Statut Membre Dernière intervention 2 759
  
  Bonsoir
  
  Je rentre et je découvre le message
  Oui Chossete a raison il faut partir de la fin
  Je viens d'essayer ça fonctionne parfaitement sii les indications que tu as données au début n'ont pas changé colonne M à AC et suppression de 11 à 27,
  Sinon évidement il faut changer les valeurs dans la macro
  
  A suivre
  
  0
Réponse 2 / 4
michel_m Messages postés 18903 Date d'inscription Statut Contributeur Dernière intervention 3 320

bin, essaies un peu de coder et si si tu y arrives pas, quelqu'un t'aideras

C'est pas vrai de lire des trucs comme ca
1
Réponse 3 / 4
steph_gdp Messages postés 35 Statut Membre 1

desolé via55 je comprends pas trop les macros,

1/ si je commence a P2 jusqu'a AF2 je change quel valeur?

2/si par la suite je dois supprimer une ligne supplementaire de 11 à 28, soit P2 jusqu'a AG2 je change quel valeur?

Merci de ta comprehension :)
0
1. via55 Messages postés 14393 Date d'inscription Statut Membre Dernière intervention 2 759
  
  Bonjour
  
  J'adapte la macro pour des cas variables Remplacer la précédente par :
  
  Sub efface()
  
  d = InputBox("Colonne de départ")
  f = InputBox("Colonne de fin")
  
  a = Range(d & "2").Column
  b = Range(f & "2").Column
  
  x = 11 + b - a
  
  For n = b To a Step -1
  
  If Cells(2, n).Value = 0 Then
  Rows(x).Select:
  Selection.Delete Shift:=xlUp
  End If
  
  x = x - 1
  Next n
  End Sub
  
  :Il suffit de rentrer P et AF ou AG lorsque te sera demandé les colonnes de debut et de fin, la macro fait le reste
  
  Les lignes à effacer commencent en ligne 11 comme voulu , c'est la ligne x = 11 + b - a dans la macro
  Si tu veux changer cette ligne de départ il faut modifier le 11 dans la macro
  
  Me dire si tout fonctionne comme tu veux
  
  Cdlmnt
  
  0
2. steph_gdp Messages postés 35 Statut Membre 1
  
  oui ca va, ca fonctionne mais comme j'ai rajouter des choses sur ma page avec une partie a supprimer en haut et une partie en bas j'ai du creer 2 macros comme ceci :
  
  y'a t'il moyen de fussionner les 2 en 1?
  
  1ere macro:
  
  Sub Efface()
  
  For n = 18 To 1 Step -1
  y = n + 12
  x = n + 10
  
  If Cells(2, y) = 0 Then
  Rows(x).Select
  Selection.Delete Shift:=xlUp
  
  End If
  
  Next n
  End Sub
  
  2eme macro:
  
  ub Efface2()
  
  For n = 19 To 1 Step -1
  y = n + 30
  x = n + 67
  
  If Cells(2, y) = 0 Then
  Rows(x).Select
  Selection.Delete Shift:=xlUp
  
  End If
  
  Next n
  End Sub
  
  merci
  
  0
3. via55 Messages postés 14393 Date d'inscription Statut Membre Dernière intervention 2 759
  
  Si tu veux que les 2 macros s'executent l'une apres l'autre :
  Sub Efface()
  
  For n = 18 To 1 Step -1
  y = n + 12
  x = n + 10
  
  If Cells(2, y) = 0 Then
  Rows(x).Select
  Selection.Delete Shift:=xlUp
  
  End If
  
  Next n
  
  For n = 19 To 1 Step -1
  y = n + 30
  x = n + 67
  
  If Cells(2, y) = 0 Then
  Rows(x).Select
  Selection.Delete Shift:=xlUp
  
  End If
  
  Next n
  End Sub
  
  0
Réponse 4 / 4
michel_m Messages postés 18903 Date d'inscription Statut Contributeur Dernière intervention 3 320
bonjour,

une alternative pour éviter cette histoire de remonter les lignes et en réduisant le nombre de boucles aux seules valeurs zéro et sans select-selection
```
Option Explicit
Sub supprimer_si_zero()
Dim Nbre_z As Byte, Col As Byte, Cptr As Byte, Ligne As Byte, Supprim As String

Application.ScreenUpdating = False
Nbre_z = Application.CountIf(Range("M2:AC2"), 0)

Col = 12
For Cptr = 1 To Nbre_z
     Col = Rows(2).Find(0, Cells(2, Col), xlValues).Column
     Ligne = Col - 2
     Supprim = Supprim & Ligne & ":" & Ligne & ","
Next

Supprim = Left(Supprim, Len(Supprim) - 1)
Range(Supprim).EntireRow.Delete
End Sub
```
0
1. steph_gdp Messages postés 35 Statut Membre 1
  
  cela fonctionne tres bien si tu pouvais m'inserer la deuxieme macro dans celle ci cela serait parfait
  
  For n = 19 To 1 Step -1
  y = n + 30
  x = n + 67
  
  0

Suppression de ligne si une cellule = 0

4 réponses

Discussions similaires

Newsletters