Effacement lignes en fonction d'une cellule

Bonjour

Je dois dans un premier temps effacer une , ou plusieurs lignes dans une colonne B ou se trouvent doublons, triplets en fonction d'une cellule vide dans une autre colonne E.

Dans un second temps je dois effacer cette seconde ou troisieme ligne pour ne garder que les lignes qui n'ont aucun doublon et aucune date dans la colonne E.

Merci de votre aide, je n'ai pratiquementaucune connaissance en VBA.

Cdlt

Bonjour Popopp et bienvenue sur le forum,

Pour que l'on réponde exactement à ta demande, peux-tu renvoyer ton fichier en mettant decouleur les lignes qui doivent être supprimées avec quelques explications sur les premières lignes.

Fais-le uniquement sur les 50 premières lignes avec deux couleurs : une pour le premier temps et une pour le second temps.

Etape 1 : tu veux supprimer les doublons de "B" quand la colonne "E" est vide ? Donc tu conserves une valeur unique dans B avec la colonne E vide... Tu auras donc potentiellement des doublons en colonne B si on ne tient pas compte de la col E.

Etape 2 : Je ne vois pas exactement ce que tu veux, pour moi, puisqu'on a supprimer les doublons quand la col E est vide, il ne peut rester que deux doublons potentiels non liés à la colonne E. Donc si doublon, il faut supprimer la ligne avec la date en colonne E ?

A+

Benoît Marchand

|Benead]

Merci déjà pour ta rapidité.

Etape 1 supprimer les lignes en jaune pour que ne reste qu'un seul exemplaire avec date de fin de travaux.

Ex : ligne 7,8 et 9 il me faut garder que la 8.

Ne tient pas compte de l'étape 2 car en visionnant le fichier suite à ta réponse un filtre sera tout à fait suffisant;

Et ca je sais faire

En fait il s'agissait dans un deuxieme temps de separer les éléments sans aucun doublon à l'origine qui n'avait pas de date de fin de travaux.

Cdlt

Popopp,

J'ai fait un truc qui devrait réponde à ta demande, mais avant de supprimer les lignes, j'ai mis "Suppr" en colonne H. Dis-moi si cela te conviens (je ne supprime pas tout à fait les mêmes lignes que toi) et si c'est bon, on supprimera réellement les lignes :

Option Explicit

Sub EffaceLigne()
   Dim Lig As Long, sSaveOEIE As String, LigFin As Long, LigGarde

   With Worksheets("Rapport 1")
      sSaveOEIE = .Cells(4, "B").Text
      LigFin = .UsedRange.Count
      .Columns("H").ClearContents
      For Lig = 5 To LigFin
         If Cells(Lig, "B").Text = Empty Then Exit For
         If (.Cells(Lig, "B").Text <> sSaveOEIE) Then   ' Changement OEIE
            sSaveOEIE = .Cells(Lig, "B").Text
            LigGarde = RechLigne(Lig, LigFin, sSaveOEIE, Worksheets("Rapport 1"))
         End If
         If Lig <> LigGarde Then .Cells(Lig, "H").Value = "Suppr"
      Next Lig
   End With   ' Feuille Rapport 1

End Sub

Private Function RechLigne(Lig As Long, LigFin As Long, sOEIE As String, Sh As Worksheet)
   Dim l As Long
   l = Lig
   Do
      If Sh.Cells(l, "E").Text <> "" Or l >= LigFin Then RechLigne = l: Exit Function
      l = l + 1
   Loop Until Sh.Cells(l, "B").Text <> sOEIE
   RechLigne = Lig
End Function

A+

Benoît Marchand

[Benead]

Benoit cela me parait super.

Tu as fait un boulot fantastique et cela me convient tout à fait.

Cdlt

Bonjour Benoit

Je suis désolé mais je vais encore avoir besoin de toi

J'ai essayé de bidouiller ta macro mais je n'arrive pas a remplacer ta ligne ou tu rajoutes sup

par la suppression totale de la ligne.

Merci de ton aide

Cordialement

Bonjour,

Le problème principal de ta demande est que quand tu veux supprimer une ligne, tu ne sais pas encore si c'est cette ligne ou une des suivantes, il est donc beaucoup plus simple de le faire en deux boucles plutôt qu'une seule. De plus il est plus simple de faire la seconde boucle en partant de la dernière ligne et en remontant vers la première, sinon il faut décrémenter la variable ligne de 1 (Lig = Lig - 1), car on a supprimé la ligne sur lequel on était, il faut donc revenir d'une ligne en arrière pour n'oublier aucune suppression.

Suppression en mode décroissant :

      For Lig = LigFin To 5 Step -1
         If .Cells(Lig, "H").Value = "Suppr" Then .Rows(Lig).Delete
      Next Lig

Suppression en mode croissant :

      For Lig = 5 To LigFin
        If .Cells(Lig, "H").Value = "Suppr" Then
            .Rows(Lig).Delete
            Lig = Lig - 1
        End If
      Next Lig

Voici la version complète et optimisée avec ScreenUpdating=False :

Option Explicit

Sub EffaceLigne()
   Dim Lig As Long, sSaveOEIE As String, LigFin As Long, LigGarde

    Application.ScreenUpdating = False
   With Worksheets("Rapport 1")
      sSaveOEIE = .Cells(4, "B").Text
      LigFin = .UsedRange.Count
      .Columns("H").ClearContents
      For Lig = 5 To LigFin
         If Cells(Lig, "B").Text = Empty Then Exit For
         If (.Cells(Lig, "B").Text <> sSaveOEIE) Then   ' Changement OEIE
            sSaveOEIE = .Cells(Lig, "B").Text
            LigGarde = RechLigne(Lig, LigFin, sSaveOEIE, Worksheets("Rapport 1"))
         End If
         If Lig <> LigGarde Then .Cells(Lig, "H").Value = "Suppr"
      Next Lig
      For Lig = LigFin To 5 Step -1
         If .Cells(Lig, "H").Value = "Suppr" Then .Rows(Lig).Delete
      Next Lig
   End With   ' Feuille Rapport 1
    Application.ScreenUpdating = True
End Sub

Private Function RechLigne(Lig As Long, LigFin As Long, sOEIE As String, Sh As Worksheet)
   Dim l As Long
   l = Lig
   Do
      If Sh.Cells(l, "E").Text <> "" Or l >= LigFin Then RechLigne = l: Exit Function
      l = l + 1
   Loop Until Sh.Cells(l, "B").Text <> sOEIE
   RechLigne = Lig
End Function

Merci Benoit cela marche impeccable.

Il est vraiment formidable de trouver des personnes comme toi qui

sont prêtes à rendre service.

J'ai acheté le VBA pour les nuls et je vais me pencher dedans

Cordialement