Trouver cellule contenant un mot spécifique

Bonjour,

Alors voila mon problème.

Je cherche à trouver un mot spécifique" PSW"au sein d'une ligne, mais cette ligne doit être sélectionnée avec la souris de sorte à pouvoir appliquer la recherche à différente ligne de manière indépendante.

De plus, une fois le mot trouvé je souhaite récupérer la colonne correspondante pour ensuite récupérer l'année et la semaine en cours.

Exemple : Dans l'onglet "fiche Unique" Si je clique sur la ligne 17 je veut que mon programme me dise à la colonne correspondante et ensuite récupérer la date et l'année situées en 9DQ et 11DQ dans ce cas.

J'ai deja un bout de programme mais cela ne fonctionne pas correctement (voir sheet 8 du fichier joint)

Merci d'avance

Bonjour

Un essai à tester. Te convient-il ?

Bye !

Bonjour,

Ci-joint une macro à tester ...

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
' Utilisation du Clic Droit
Dim nomcherche As String
Dim result As Range
Dim i As Long
i = Target.Row
nomcherche = "PSW"
Set result = Range(Cells(i, 1), Cells(i, 500)).Find(What:=nomcherche, LookIn:=xlValues, lookat:=xlWhole)
  If result Is Nothing Then
    MsgBox "Non trouvé"
  Else
    MsgBox result.Address(0, 0)
  End If
Cancel = True
End Sub

En espérant que cela t'aide ...

Bonjour et merci de votre aide !

Je compte garder la proposition de James007 simplement car je trouve celle-ci beaucoup plus simple à comprendre au vut de mon niveau...

Nouvelle question : Je souhaite maintenant récupérer les informations contenues dans les lignes 11 et 9 de la colonne obtenu lors de l'utilisation du programme précédent et envoyer les informations récupérer dans 2 combo box différentes.

Merci d'avance

Bonjour,

D'apès ton dernier message ... tu ne devrais plus avoir besoin de la MsgBox ...

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
' Utilisation du Clic Droit
Dim nomcherche As String
Dim result As Range
Dim i As Long
i = Target.Row
nomcherche = "PSW"
Set result = Range(Cells(i, 1), Cells(i, 500)).Find(What:=nomcherche, LookIn:=xlValues, lookat:=xlWhole)
  If result Is Nothing Then
    MsgBox "Non trouvé"
  Else
    AjoutProjet.BOXPSW.Value = Cells(11, result.Column).Value
    AjoutProjet.BoxYPSW.Value = Cells(9, result.Column).Value
    'MsgBox result.Address(0, 0)
  End If
Cancel = True
End Sub

En espérant que cela t'aide ...

Nikel merci ca fonctionne j'ai adapté le programme à tout mes statuts possible, mais il reste un dernier souci l'idée est de pouvoir modifier les données ( Semaine etc....) que donne l'Userform par rapport à la ligne sur laquelle on clique.

A l'heure actuel je récupère bien les données de la ligne sélectionnée mais lorsque je modifie certaine donnée et valide dans l'Userform celle-ci me génère une nouvelle ligne en fin de tableau avec les nouveaux paramètres or je souhaite directement modifié la ligne sélectionné.

Merci d'avance de votre temps

Private Sub CommandButton1_Click()

 Cells(ActiveCell.Row, 1) = Projet.TextBox1.Text
 Cells(ActiveCell.Row, 2) = Projet.TextBox2.Text
 Cells(ActiveCell.Row, 3) = Projet.ComboBox13.Text
 Cells(ActiveCell.Row, 4) = Projet.TextBox4.Text

Dim i, b, a, C, J, h
For i = 13 To 300
If SheetS("Fiche Unique").Cells(i, 1) <> "" Or SheetS("Fiche Unique").Cells(i, 2) <> "" Or SheetS("Fiche Unique").Cells(i, 3) <> "" Then
b = b + 1
End If
Next

a = 13 + b

SheetS("Fiche Unique").Cells(a, 1).Value = TextBox1.Value
SheetS("Fiche Unique").Cells(a, 2).Value = TextBox2.Value
SheetS("Fiche Unique").Cells(a, 3).Value = ComboBox13.Value

SheetS("Auto").Cells(a, 1).Value = ComboBox13.Value & "_" & TextBox1.Value
SheetS("Auto").Cells(a, 21).Value = ComboBox1.Value
SheetS("Auto").Cells(a, 22).Value = ComboBox2.Value
SheetS("Auto").Cells(a, 23).Value = ComboBox3.Value
SheetS("Auto").Cells(a, 24).Value = ComboBox4.Value
SheetS("Auto").Cells(a, 25).Value = ComboBox5.Value
SheetS("Auto").Cells(a, 26).Value = ComboBox6.Value
SheetS("Auto").Cells(a, 27).Value = ComboBox7.Value
SheetS("Auto").Cells(a, 28).Value = ComboBox8.Value
SheetS("Auto").Cells(a, 29).Value = ComboBox9.Value
SheetS("Auto").Cells(a, 30).Value = ComboBox10.Value
SheetS("Auto").Cells(a, 31).Value = ComboBox11.Value
SheetS("Auto").Cells(a, 32).Value = ComboBox12.Value

For J = 8 To 200
For h = 2 To 8

If SheetS("Fiche Unique").Cells(12, J) = SheetS("Auto").Cells(a, h) Then
        SheetS("Fiche Unique").Cells(a, J) = SheetS("Auto").Cells(13, h)
        SheetS("Auto").Cells(a, h + 40) = SheetS("Fiche Unique").Cells(8, J)
End If

Next

If SheetS("Fiche Unique").Cells(a, J) = "Control Plan Client" Then
    SheetS("Fiche Unique").Cells(a, J).Interior.Color = RGB(244, 176, 132)
End If
If SheetS("Fiche Unique").Cells(a, J) = "Agrément Composant" Then
    SheetS("Fiche Unique").Cells(a, J).Interior.Color = RGB(153, 102, 255)
End If
If SheetS("Fiche Unique").Cells(a, J) = "Moyen de Contrôle" Then
    SheetS("Fiche Unique").Cells(a, J).Interior.Color = RGB(189, 215, 238)
End If
If SheetS("Fiche Unique").Cells(a, J) = "Capabilités" Then
    SheetS("Fiche Unique").Cells(a, J).Interior.Color = RGB(255, 255, 153)
End If
If SheetS("Fiche Unique").Cells(a, J) = "PSW" Then
    SheetS("Fiche Unique").Cells(a, J).Interior.Color = RGB(255, 204, 204)
End If
If SheetS("Fiche Unique").Cells(a, J) = "AS 403" Then
   SheetS("Fiche Unique").Cells(a, J).Interior.Color = RGB(192, 64, 0)
End If
Next

Projet.Hide

'Sub Check()

Range("F14:F200").Select
Selection.ClearContents

For i = 14 To 300

If SheetS("Fiche Unique").Cells(i, 1) <> "" Then
        For J = 8 To 492
        If SheetS("Fiche Unique").Cells(i, J) <> "" Then
        b = SheetS("Fiche Unique").Cells(8, J)
        If b < Now + 30 And SheetS("Fiche Unique").Cells(i, J).Interior.Color <> RGB(0, 176, 80) Then
        SheetS("Fiche Unique").Cells(i, 6) = "OUI"
        End If
        If b < Now And SheetS("Fiche Unique").Cells(i, J).Interior.Color <> RGB(0, 176, 80) And SheetS("Fiche Unique").Cells(i, J) <> "" Then
        SheetS("Fiche Unique").Cells(i, J).Interior.Color = RGB(255, 0, 0)
        End If
        End If
        Next

End If

If SheetS("Fiche Unique").Cells(i, 6) = "OUI" Then SheetS("Fiche Unique").Cells(i, 6).Interior.Color = RGB(255, 192, 0)
If SheetS("Fiche Unique").Cells(i, 6) = "" Then SheetS("Fiche Unique").Cells(i, 6).Interior.Color = RGB(255, 255, 255)

Next

Unload Me

End Sub

Private Sub UserForm_Initialize()

Dim i, J

For i = 1 To 53

    With ComboBox1
    .AddItem "S" & "" & i
    End With
    With ComboBox3
    .AddItem "S" & "" & i
    End With
    With ComboBox5
    .AddItem "S" & "" & i
    End With
    With ComboBox7
    .AddItem "S" & "" & i
    End With
    With ComboBox9
    .AddItem "S" & "" & i
    End With
    With ComboBox11
    .AddItem "S" & "" & i
    End With

Next

For J = 2015 To 2030

    With ComboBox2
    .AddItem J
    End With
    With ComboBox4
    .AddItem J
    End With
    With ComboBox6
    .AddItem J
    End With
    With ComboBox8
    .AddItem J
    End With
    With ComboBox10
    .AddItem J
    End With
    With ComboBox12
    .AddItem J
    End With
Next

    With ComboBox13
    .AddItem "SAB"
    .AddItem "CAB"
    .AddItem "DAB"
    .AddItem "PAB"
    .AddItem "KAB"
    .AddItem "SB"
    .AddItem "BK"
    .AddItem "PHL"
    End With

End Sub

Re,

Content que cela fonctionne ...

Merci pour tes remerciements ...

Concernant le point que tu soulèves ... une piste : c'est d'avoir une variable qui contient le numéro de la bonne ligne ...

Ok merci beaucoup de votre aide ! je regarde ca voir si je m'en sors seul

Ok merci beaucoup de votre aide ! je regarde ca voir si je m'en sors seul

Re,

Bon Courage ...

En cas d'obstacle ... il ne faut pas hésiter à revenir sur le Forum ...

Bon me revoilà

J'ai intégré une variable ligne mais je ne comprend pas l'erreur obtenu.

De plus ma feuille intermédaire "Auto" Prend bien en compte les changements de semaine ou année mais les changements ne s'applique pas sur la feuille "Fiche Unique" .

Exemple je change la semaine de "PSW" grace à l'userform "Projet" les changements se font dans la feuille "auto" mais pas dans la feuille principale.

Je suis à peu près sur que l'erreur se trouve dans cette partie de code mais où ....

merci d'avance

Private Sub CommandButton1_Click()

 Cells(ActiveCell.Row, 1) = Projet.TextBox1.Text
 Cells(ActiveCell.Row, 2) = Projet.TextBox2.Text
 Cells(ActiveCell.Row, 3) = Projet.ComboBox13.Text
 Cells(ActiveCell.Row, 4) = Projet.TextBox4.Text

maligne = ActiveCell.Row
Dim i, b, a, C, J, h
For i = 13 To 300
'If SheetS("Fiche Unique").Cells(i, 1) <> "" Or SheetS("Fiche Unique").Cells(i, 2) <> "" Or SheetS("Fiche Unique").Cells(i, 3) <> "" Then

     'b = b + 1

 If SheetS("Fiche Unique").Cells(i, 1) = ComboBox13.Value & "_" & TextBox1.Value Then
 a = maligne

End If
Next

'a = 13 + b

SheetS("Fiche Unique").Cells(a, 1).Value = TextBox1.Value
SheetS("Fiche Unique").Cells(a, 2).Value = TextBox2.Value
SheetS("Fiche Unique").Cells(a, 3).Value = ComboBox13.Value

SheetS("Auto").Cells(a, 1).Value = ComboBox13.Value & "_" & TextBox1.Value
SheetS("Auto").Cells(a, 21).Value = ComboBox1.Value
SheetS("Auto").Cells(a, 22).Value = ComboBox2.Value
SheetS("Auto").Cells(a, 23).Value = ComboBox3.Value
SheetS("Auto").Cells(a, 24).Value = ComboBox4.Value
SheetS("Auto").Cells(a, 25).Value = ComboBox5.Value
SheetS("Auto").Cells(a, 26).Value = ComboBox6.Value
SheetS("Auto").Cells(a, 27).Value = ComboBox7.Value
SheetS("Auto").Cells(a, 28).Value = ComboBox8.Value
SheetS("Auto").Cells(a, 29).Value = ComboBox9.Value
SheetS("Auto").Cells(a, 30).Value = ComboBox10.Value
SheetS("Auto").Cells(a, 31).Value = ComboBox11.Value
SheetS("Auto").Cells(a, 32).Value = ComboBox12.Value

For J = 8 To 200
For h = 2 To 8

If SheetS("Fiche Unique").Cells(12, J) = SheetS("Auto").Cells(a, h) Then
        SheetS("Fiche Unique").Cells(a, J) = SheetS("Auto").Cells(13, h)
        SheetS("Auto").Cells(a, h + 40) = SheetS("Fiche Unique").Cells(8, J)
End If

Next

If SheetS("Fiche Unique").Cells(a, J) = "Control Plan Client" Then
    SheetS("Fiche Unique").Cells(a, J).Interior.Color = RGB(244, 176, 132)
End If
If SheetS("Fiche Unique").Cells(a, J) = "Agrément Composant" Then
    SheetS("Fiche Unique").Cells(a, J).Interior.Color = RGB(153, 102, 255)
End If
If SheetS("Fiche Unique").Cells(a, J) = "Moyen de Contrôle" Then
    SheetS("Fiche Unique").Cells(a, J).Interior.Color = RGB(189, 215, 238)
End If
If SheetS("Fiche Unique").Cells(a, J) = "Capabilités" Then
    SheetS("Fiche Unique").Cells(a, J).Interior.Color = RGB(255, 255, 153)
End If
If SheetS("Fiche Unique").Cells(a, J) = "PSW" Then
    SheetS("Fiche Unique").Cells(a, J).Interior.Color = RGB(255, 204, 204)
End If
If SheetS("Fiche Unique").Cells(a, J) = "AS 403" Then
   SheetS("Fiche Unique").Cells(a, J).Interior.Color = RGB(192, 64, 0)
End If
Next

Projet.Hide

'Sub Check()

Range("F14:F200").Select
Selection.ClearContents

For i = 14 To 300

If SheetS("Fiche Unique").Cells(i, 1) <> "" Then
        For J = 8 To 492
        If SheetS("Fiche Unique").Cells(i, J) <> "" Then
        b = SheetS("Fiche Unique").Cells(8, J)
        If b < Now + 30 And SheetS("Fiche Unique").Cells(i, J).Interior.Color <> RGB(0, 176, 80) Then
        SheetS("Fiche Unique").Cells(i, 6) = "OUI"
        End If
        If b < Now And SheetS("Fiche Unique").Cells(i, J).Interior.Color <> RGB(0, 176, 80) And SheetS("Fiche Unique").Cells(i, J) <> "" Then
        SheetS("Fiche Unique").Cells(i, J).Interior.Color = RGB(255, 0, 0)
        End If
        End If
        Next

End If

If SheetS("Fiche Unique").Cells(i, 6) = "OUI" Then SheetS("Fiche Unique").Cells(i, 6).Interior.Color = RGB(255, 192, 0)
If SheetS("Fiche Unique").Cells(i, 6) = "" Then SheetS("Fiche Unique").Cells(i, 6).Interior.Color = RGB(255, 255, 255)

Next

Unload Me

End Sub

Re,

Je ne connais pas la différence entre ta feuille "auto" et ta feuille principale ...

SI tu as un décalage constant entre les deux feuilles ... il suffit de rajouter ce décalage à ta variable ...

Re,

Bon maintenant j'arrive à obtenir les changements dans la feuille " Fiche Unique" MAIS malheureusement au lieu de modifier la ligne sélectionné, le programme en crée une nouvelle en fin de tableau... Il reste pu que cette erreur et le fichier sera pleinement opérationnel !

Ma feuille auto me permet de faire le lien grace au semaine et année.

Merci pour tout Mr BOND

De rien ...

Merci pour tes remerciements ...

Bonne Continuation ...

Rechercher des sujets similaires à "trouver contenant mot specifique"