Compléter un code par un test

Résolu
diabolo5495 Messages postés 119 Statut Membre -  
diabolo5495 Messages postés 119 Statut Membre -
Bonjour à tous,

Voilà j'avais déjà fait appel à vos services pour un code en VBA. Et de nouveau bloqué, j'ai donc encore besoin de votre aide. Voilà le problème : voici un code que pijaku m'avais bien aider à mettre en place mais je dois y ajouter un test supplémentaire. 

Sub Personne()
Dim RngCherche As Range
Dim mot_chercher As String, firstAddress As String
Dim i As Integer

i = 2 'le premier mot trouvé sera placé en B2 de la Feuil3
mot_chercher = "*" + "Personne" + "*"
Set RngCherche = Sheets("Pilotage").Cells.Find(mot_chercher, lookat:=xlWhole)
If Not RngCherche Is Nothing Then
    firstAddress = RngCherche.Address
    Sheets("Personne").Range("B" & i) = RngCherche.Offset(0, -2).Value
    i = i + 1
    Do
        Set RngCherche = Sheets("Pilotage").Cells.FindNext(RngCherche)
        Sheets("Personne").Range("B" & i) = RngCherche.Offset(0, -2).Value
        i = i + 1
    Loop While Not RngCherche Is Nothing And RngCherche.Address <> firstAddress
Else
     MsgBox "Pas de tâche pour" + mot_chercher
End If
Set RngCherche = Nothing
End Sub


Dans ce code, il faudrait que lorsque qu'il trouve la fameuse Personne, il fasse, sur la cellule décalé de deux vers la droite de la ligne où il a trouvé Personne, il fasse un test pour voir si "100" apparait et ainsi mettre le texte qu'il écrit normalement par ce code 
Sheets("Personne").Range("B" & i) = RngCherche.Offset(0, -2).Value
en rouge.

Voili Voilou

En espérant avoir été clair, et en vous remerciant d'avance

Bonne journée

2 réponses

  1.
    pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
     
    Bonjour,

    Plusieurs choses me gênent dans ce code :
    1- dans la variable mot_chercher tu insères une valeur incomplète ("*" blabla "*"). Puis, après dans le code, tu utilises Lookat:=xlwhole. En fait, la propriété lookat de .find te permet de chercher une partie ou le tout.
    Donc au lieu de mettre des * et le lookat:=xlwhole, tu peux indiquer : 
    mot_chercher = "Personne"
Set RngCherche = Sheets("Pilotage").Cells.Find(mot_chercher, lookat:=xlPart)


    2- Tu cherches dans toute ta feuille après le mot personne. Puis, tu renvoie une valeur contenue deux colonnes à GAUCHE de l'endroit trouvé (RngCherche.Offset(0, -2).Value). C'est source de plantage si ta macro trouve personne en colonne A ou B...

    Sinon, essaye ceci (en gras les modifs) : 
    Sub Personne()
Dim RngCherche As Range
Dim mot_chercher As String, firstAddress As String
Dim i As Integer

i = 2 'le premier mot trouvé sera placé en B2 de la Feuil3
mot_chercher = "Personne"
Set RngCherche = Sheets("Pilotage").Cells.Find(mot_chercher, lookat:=xlPart)
If Not RngCherche Is Nothing Then
    firstAddress = RngCherche.Address
    Sheets("Personne").Range("B" & i) = RngCherche.Offset(0, -2).Value
    If RngCherche.Offset(0, 2) = 100 Then Sheets("Personne").Range("B" & i).Interior.ColorIndex = 3
    i = i + 1
    Do
        Set RngCherche = Sheets("Pilotage").Cells.FindNext(RngCherche)
        Sheets("Personne").Range("B" & i) = RngCherche.Offset(0, -2).Value
        If RngCherche.Offset(0, 2) = 100 Then Sheets("Personne").Range("B" & i).Interior.ColorIndex = 3
        i = i + 1
    Loop While Not RngCherche Is Nothing And RngCherche.Address <> firstAddress
Else
     MsgBox "Pas de tâche pour" + mot_chercher
End If
Set RngCherche = Nothing
End Sub
    1
    1. diabolo5495 Messages postés 119 Statut Membre 27
       
      Bonjour et merci d'avoir répondu aussi vite. Je viens de tester le code. Le problème est que la cellule à tester le 100 contient en fait un pourcentage, donc écrit "100%". Cette page Pilotage m'ayant était fourni, le signe pourcentage s'affiche automatiquement donc je ne peux pas le supprimer :-S. Donc en fait, il faudrait qu'il teste qu'il y ait "100%" et non "100" ce qui est bien plus embêtant à mettre en place je l'admet. En tout cas merci bien pour les optimisations que tu m'as déjà apporter, il est vrai que c'était un peu du bricolage le code que j'ai présenté mais cela fonctionné quand même :-)
      0
    2. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      Pour le %age, je vais te laisser trouver par toi même...
      0
    3. diabolo5495 Messages postés 119 Statut Membre 27
       
      J'ai déjà tester un truc mais ma macro tournait en boucle et a planté Excel ! Donc je sais qu'il faut pas faire ce que je viens de faire ^^ mais je vais trouver ^^
      0
    4. diabolo5495 Messages postés 119 Statut Membre 27
       
      Bon j'ai tenté ceci, mais ça ne fonctionne pas (Sidot = Personne) 

      Sub Sidot()
Dim RngCherche As Range, RngCherche2 As Range
Dim mot_chercher As String, firstAddress As String, pourcent_chercher As String
Dim i As Integer

i = 2 'le premier mot trouvé sera placé en B2 de la Feuil3
mot_chercher = "Sidot"
pourcent_chercher = "100"
Set RngCherche = Sheets("Pilotage").Cells.Find(mot_chercher, lookat:=xlPart)
If Not RngCherche Is Nothing Then
    firstAddress = RngCherche.Address
    Sheets("Sidot").Range("B" & i) = RngCherche.Offset(0, -2).Value
    If RngCherche2 = Sheets("Pilotage").Cells.RngCherche.Find(pourcent_chercher, lookat:=xlPart) Then Sheets("Personne").Range("B" & i).Interior.ColorIndex = 3
    i = i + 1
    Do
        Set RngCherche = Sheets("Pilotage").Cells.FindNext(RngCherche)
        Sheets("Sidot").Range("B" & i) = RngCherche.Offset(0, -2).Value
        If RngCherche2 = Sheets("Pilotage").Cells.RngCherche.Find(pourcent_chercher, lookat:=xlPart) Then Sheets("Personne").Range("B" & i).Interior.ColorIndex = 3
        i = i + 1
    Loop While Not RngCherche Is Nothing And RngCherche.Address <> firstAddress
Else
     MsgBox "Pas de tâche pour" + mot_chercher
End If
Set RngCherche = Nothing
End Sub
      0
    5. diabolo5495 Messages postés 119 Statut Membre 27
       
      Je me rend compte que j'ai oublié l'offset(0, 2) entre autre mais je ne pense pas que le problème vienne de cela
      0
  2. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Bonjour,

    deux vers la droite l'offset doit etre positif donc pas ceci:

    Sheets("Personne").Range("B" & i) = RngCherche.Offset(0, -2).Value

    mais:

    Sheets("Personne").Range("B" & i) = RngCherche.Offset(0, 2).Value

    Bonne suite
    0
    1. diabolo5495 Messages postés 119 Statut Membre 27
       
      Cet offset est bien négatif car il permet de copier le texte de la cellule qui se trouve deux colonnes avant pour la coller dans une autre page ;-) mais merci quand même d'avoir répondu
      0