Macro suppression cellules sous conditions

[océanne]

Bonsoir tout le forum,

J'ai mis en pj un fichier avec mes explications, en fait je souhaite pouvoir supprimer des cellules dans un tableau de trois colonnes, sous conditions.

J'ai mis les lignes de code que j'ai essayé vainement d'écrire, je ne dois pas être bien loin de mon résultat, mais là je coince.

Merci par avance pour votre aide.

O.

 

[ROGER2327]

Re : Macro suppression cellules sous conditions

Bonjour océanne

Peut-être ceci :

[COLOR="DarkSlateGray"][B]Sub TEST3()
Dim I As Long
Dim c As Range
Dim MesNoms As Range
Dim plg As Range
   Set MesNoms = Range("F4:F" & Range("F4").End(xlDown).Row)
   Set plg = Range("B5:B" & Range("B5").End(xlDown).Row)
   For I = plg.Rows.Count To 1 Step -1
      With plg.Cells(I, 1)
         For Each c In MesNoms.Cells
            If .Value = c.Value Then
               Range(.Offset(0, -1), .Offset(0, 1)).Delete Shift:=xlUp
            End If
         Next c
      End With
   Next I
End Sub[/B][/COLOR]

ROGER2327
#2613

 

[océanne]

Re : Macro suppression cellules sous conditions

Bonjour Roger,

Merci de vous être penché sur mon problème, mais malheureusement le code bloque sur :

If .Value = c.Value Then

avec dans la petite bulle explicative : objet requis.

Si une autre âme charitable a une idée, elle sera la bienvenue. N'hésitez pas à refondre les lignes de codes si nécessaire ou par simplification.

En tous cas Roger merci pour votre aide.

Bonne journée

O.

 

[Paritec]

Re : Macro suppression cellules sous conditions

Bonjour Roger Océanne, le forum
vois ci cela te convient
a+
papou 🙂

 

[océanne]

Re : Macro suppression cellules sous conditions

Bonjour PARITEC,

Merci pour ton appui. J'obtiens bien le résultat escompté, seul souci, mais il est de taille, comme je n'avais mis qu'un échantillon en colonne ABC, si j'ajoute d'autres noms, j'ai environ 100 à 200 lignes.....il faut que je relance plusieurs fois la macro pour obtenir le résultat attendu, as-tu une idée, pour que je parvienne à mon résultat en ne la lançant qu'une fois ?

Merci pour ta réponse et bonne journée.

O.

 

[Paritec]

Re : Macro suppression cellules sous conditions

Bonjour Océanne le forum
Océanne tu me dis quoi? la macro elle se moque du nombre de lignes que ce soit dans la colonne B ou F de mémoire la longueur de la liste se dimensionne automatiquement. Donc si tu lances trier elle fait son boulot c'est sur, par contre si tes prénoms sont écris de manières différentes Paul paul pour excel c'est pas le même prénom ou alors il faut ajouter en haut Option Compare text
alors si ton fichier est fait de manière différente là peut-être
enfin si tu veux je te donne en MP mon adresse mail pour voir ton fichier et je te dirai
a+
papou 🙂

 

[Paritec]

Re : Macro suppression cellules sous conditions

Re Océanne
je sais pourquoi tu as un souci dans l'exemple que tu avais donnée tu avais des résultats en dessous de tes données donc j'ai défini la fin de boucle avec xldown, mais si tu as des cellules vides cela ne marchera pas tu peux essayer comme cela si c'est le cas tout va marcher
a+
papou 🙂

 

[Paritec]

Re : Macro suppression cellules sous conditions

Re Océanne le forum
si tu as des lignes vides essayes comme cela les lignes vides seront supprimées aussi comme les noms présents de la liste en F
a+
Papou🙂

Sub trier()
    Dim a, b As Long
    For a = Feuil1.Range("B65000").End(xlUp).Row To 5 Step -1
        For b = 4 To Feuil1.Range("F4").End(xlDown).Row+1
            If Cells(a, 2) = Cells(b, 6) Then
                Range(Cells(a, 1), Cells(a, 3)).Delete shift:=xlUp
            End If
        Next
    Next
End Sub

 

[océanne]

Re : Macro suppression cellules sous conditions

Re PARITEC PAPOU et le forum

Deux Grosses bises PAPOU, c'est exactement ce que je voulais, merci encore pour ta disponibilité et le partage de tes connaissances.

Bonne journée

 

[ROGER2327]

Re : Macro suppression cellules sous conditions

Re...

Bonjour Roger,

Merci de vous être penché sur mon problème, mais malheureusement le code bloque sur :

If .Value = c.Value Then

avec dans la petite bulle explicative : objet requis.
(...)

Oui !
Une étourderie...
Code corrigé :

[COLOR="DarkSlateGray"][B]Sub TEST3()
Dim I As Long
Dim c As Range
Dim MesNoms As Range
Dim plg As Range
   Set MesNoms = Range("F4:F" & Range("F4").End(xlDown).Row)
   Set plg = Range("B5:B" & Range("B5").End(xlDown).Row)
   For I = plg.Rows.Count To 1 Step -1
      [COLOR="Sienna"]For Each c In MesNoms.Cells
         With plg.Cells(I, 1)[/COLOR]
            If plg.Cells(I, 1).Value = c.Value Then
               Range(.Offset(0, -1), .Offset(0, 1)).Delete Shift:=xlUp
            End If
         [COLOR="Sienna"]End With
      Next c[/COLOR]
   Next I
End Sub[/B][/COLOR]

ROGER2327
#2614