Trouver cellule contenant un mot spécifique

Y compris Power BI, Power Query et toute autre question en lien avec Excel
P
Papi27190
Membre habitué
Membre habitué
Messages : 84
Inscrit le : 30 octobre 2017
Version d'Excel : 2013 EN

Message par Papi27190 » 20 décembre 2017, 15:21

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)
Fiche de Suivi.xlsm
(1021.49 Kio) Téléchargé 8 fois

Merci d'avance :wink:
g
gmb
Fanatique d'Excel
Fanatique d'Excel
Messages : 12'684
Appréciations reçues : 343
Inscrit le : 4 avril 2013
Version d'Excel : 2016

Message par gmb » 20 décembre 2017, 16:04

Bonjour

Un essai à tester. Te convient-il ?
Bye !
Fiche de Suivi v1.xlsm
(188.47 Kio) Téléchargé 8 fois
Avatar du membre
James007
Fanatique d'Excel
Fanatique d'Excel
Messages : 11'999
Appréciations reçues : 417
Inscrit le : 30 août 2014
Version d'Excel : 2007 EN

Message par James007 » 20 décembre 2017, 16:08

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 ...
A+

:)

Quand on n’a qu’un marteau, tous les problèmes deviennent des clous…
P
Papi27190
Membre habitué
Membre habitué
Messages : 84
Inscrit le : 30 octobre 2017
Version d'Excel : 2013 EN

Message par Papi27190 » 21 décembre 2017, 08:56

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... :mrgreen:

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 :)
Avatar du membre
James007
Fanatique d'Excel
Fanatique d'Excel
Messages : 11'999
Appréciations reçues : 417
Inscrit le : 30 août 2014
Version d'Excel : 2007 EN

Message par James007 » 21 décembre 2017, 09:15

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 ...
A+

:)

Quand on n’a qu’un marteau, tous les problèmes deviennent des clous…
P
Papi27190
Membre habitué
Membre habitué
Messages : 84
Inscrit le : 30 octobre 2017
Version d'Excel : 2013 EN

Message par Papi27190 » 21 décembre 2017, 10:30

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
Modifié en dernier par Papi27190 le 21 décembre 2017, 10:42, modifié 1 fois.
Avatar du membre
James007
Fanatique d'Excel
Fanatique d'Excel
Messages : 11'999
Appréciations reçues : 417
Inscrit le : 30 août 2014
Version d'Excel : 2007 EN

Message par James007 » 21 décembre 2017, 10:36

Re,

Content que cela fonctionne ... :wink:

Merci pour tes remerciements ...:smile:

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

:)

Quand on n’a qu’un marteau, tous les problèmes deviennent des clous…
P
Papi27190
Membre habitué
Membre habitué
Messages : 84
Inscrit le : 30 octobre 2017
Version d'Excel : 2013 EN

Message par Papi27190 » 21 décembre 2017, 10:49

Ok merci beaucoup de votre aide ! je regarde ca voir si je m'en sors seul :) :o
Avatar du membre
James007
Fanatique d'Excel
Fanatique d'Excel
Messages : 11'999
Appréciations reçues : 417
Inscrit le : 30 août 2014
Version d'Excel : 2007 EN

Message par James007 » 21 décembre 2017, 10:57

Papi27190 a écrit :
21 décembre 2017, 10:49
Ok merci beaucoup de votre aide ! je regarde ca voir si je m'en sors seul :) :o
Re,

Bon Courage ... ;;)

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

:)

Quand on n’a qu’un marteau, tous les problèmes deviennent des clous…
P
Papi27190
Membre habitué
Membre habitué
Messages : 84
Inscrit le : 30 octobre 2017
Version d'Excel : 2013 EN

Message par Papi27190 » 21 décembre 2017, 12:34

Bon me revoilà :lole:

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
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message