[Excel VBA]

Résolu
Gorion87 -  
Bonjour,

Dans le cadre d'un TDB je sollicite votre aide afin de résoudre mon problème.

Je vous joins le fichier :

https://www.cjoint.com/?dejMlbQMOx

Ce que je souhaiterai en fait c’est que la macro recherche dans la colonne D le mot « INTERE » que cela selectionne les lignes jusqu’à ce que le mot « CAPITA » soit trouvé mais que la selection s’arrete à la ligne au-dessus. Une fois la selection effectuée, que cela supprime les lignes entières de la selection. Dans le but d’eviter les doublons CAPITA et INTERE qui reprennent les memes données.

Dans un second temps il faudrait que les lignes vides en-dessous du nom de chaque client soit rempli des données de la ligne client originale.

Dans l’onglet « Version Finale » du fichier vous retrouverez ce que cela doit donner au final :-)

Je vous joins une macro que j'ai testé mais qui marche pas :

Dim sh As Excel.Worksheet, x As Long, i As Integer
Set sh = Sheets("Regroupement")
For x = sh.Range("D" & Application.Rows.Count).End(xlUp).Row To 2 Step -1
If sh.Range("D" & x).Value Like "*INTERE*" Then
For i = 1 To Range("D:D").Value = "*CAPITA*" Step - 1
sh.Rows(x).Delete
Next i
End If
Next x
Set sh = Nothing

End Sub

Merci pour votre aide.
Configuration: Windows 2003
Internet Explorer 6.0

4 réponses

  1. Gorion87 Auteur
    J'ai crée un nouveau post sur ce lien :

    http://www.commentcamarche.net/forum/affich 11327375 excel vba rech mots suppr jusqua autre mot

    Je me suis rendu compte que le titre du post n'était pas complet
    0
    1. Gorion87 Auteur
      Ok je te remercie :-)

      Pour la macro que tu mas donné en fait elle me supprime bien quand elle trouve INTERE mais elle le fait qu'une fois il n'y a pas de boucle !!!
      0
      1. michel_m Contributeur
        re,

        excuses moi, j'avais mal lu ta demande

        je regarderais en fin d'après midi si personne ne t'as apporté de solution satisfaisante
        0
        1. michel_m Contributeur
          Bonjour,

          ces instructions détruisent les lignes entre "dddinterevvv" et "azecapitarty" 
          On Error Resume Next
lig_int = Columns(4).Find("intere", Range("D1"), , xlPart).Row + 1
lig_cap = Columns(4).Find("cap", Range("D1"), , xlPart).Row - 1
If Err > 0 Then
    MsgBox "terme recherché non trouvé"
    Exit Sub
End If
On Error GoTo 0
Rows(lig_int & ":" & lig_cap).Delete


          Pour l'instant, je n'ai pas accès aux téléchargements....
          0