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,
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
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 ...