Compléter un code par un test

Résolu

diabolo5495 Messages postés 112 Date d'inscription Statut Membre Dernière intervention -
diabolo5495 Messages postés 112 Date d'inscription Statut Membre Dernière intervention - 23 juil. 2013 à 10:29

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

Afficher la suite

A voir également:

Compléter un code par un test
Test performance pc - Guide
Code ascii - Guide
Comment déverrouiller un téléphone quand on a oublié le code - Guide
Test disque dur - Télécharger - Informations & Diagnostic
Test composant pc - Guide

2 réponses

Réponse 1 / 2

pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention 2 761

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