Recherche valeur dans une colonne déterminée

Résolu
volfoss Messages postés 43 Statut Membre -  
volfoss Messages postés 43 Statut Membre -
Bonjour,

J'ai une macro qui me permet d'effectuer une recherche dans un tableau mais je n'arrive pas à faire en sorte que la recherche s'effectue uniquement dans la colonne O de la feuille active.
Mon code:

Dim Mot As String
Dim Ws As Object
Dim Nbre As Long
Dim Cycle As Long
Dim Trouvé As Variant
Dim CellAddress As Variant
Dim MyValue As String
'Définition de la variable à rechercher
Mot = InputBox("Saisir le N° de fiche à chercher.", Title:="Recherche")
'Vérification si existante
If Mot = "" Then Exit Sub
For Each Ws In Worksheets
Nbre = Nbre + Application.CountIf(Ws.UsedRange, "=" & Mot)
Next Ws
'Message en cas de mot inexistant
If Nbre = 0 Then
MyValue = MsgBox(" La fiche " & Mot & " n'est pas enregistrée ", vbOKOnly, " Message ")
Else
Cycle = 0
'Recherche et arrêt sur les cellules contenant le Mot
For Each Ws In Worksheets
With Ws
.Activate
Set Trouvé = .Cells.Find(What:=Mot, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole)
If Not Trouvé Is Nothing Then
CellAddress = Trouvé.Address
Do
Trouvé.Activate
MyValue = MsgBox(" La fiche " & Mot & " a été trouvée ", vbOKOnly, " Message ")
Exit Sub

2 réponses

  1. Gyrus Messages postés 3360 Statut Membre 526
     
    Bonjour,

    Essaie comme cela :
    Sub Test()
    Dim Mot As String, Msg_Titre As String, Msg_Init As String, Msg_Corps As String, Adresse_Début As String
    Dim Ws As Worksheet
    Dim Cel As Range
    Dim Nbre As Long
    'Définition de la variable à rechercher
    Mot = InputBox("Saisir le N° de fiche à chercher.", Title:="Recherche")
    'Vérification si existante
    If Mot = "" Then Exit Sub
    Msg_Titre = "RECHERCHE"
    Msg_Init = "Fiche recherchée : " & Mot & Chr(10) & Chr(10) & "Nombre de fiches trouvées : "
    Msg_Corps = "Emplacement :" & Chr(10)
    For Each Ws In Worksheets
    Set Cel = Ws.Columns(15).Find(Mot, , xlValues, xlWhole)
    If Not Cel Is Nothing Then
    Adresse_Début = Cel.Address
    Do
    Msg_Corps = Msg_Corps & "Feuille " & Ws.Name & " : " & Cel.Address(0, 0) & Chr(10)
    Nbre = Nbre + 1
    Set Cel = Ws.Columns(15).FindNext(Cel)
    Loop While Not Cel Is Nothing And Cel.Address <> Adresse_Début
    End If
    Next Ws
    If Nbre > 0 Then
    MsgBox Msg_Init & Nbre & Chr(10) & Chr(10) & Msg_Corps, vbOKOnly, Msg_Titre
    Else
    MsgBox "Aucune fiche trouvée.", " Message "
    End If
    End Sub


    A+
    3
    1. volfoss Messages postés 43 Statut Membre 3
       
      Ta macro fonctionne parfaitement quand la fiche existe; de plus comme j'ai 2 feuilles où je voulais utiliser la fonction recherche je peux le faire en une fois car ta macro recherche sur mes 2 feuilles.
      Par contre si la fiche n'existe pas encore ta macro plante sur la ligne:
      MsgBox "Aucune fiche trouvée.", " Message "
      Je vais essayer de modifier ta macro pour que le résultat de la recherche soit encadrer comme avec ma macro de départ car ta macro donne sous forme de texte l'emplacement de la fiche recherchée. Mais cela me conviens ainsi.
      Je te remercie.
      Amicalement.
      0
    2. volfoss Messages postés 43 Statut Membre 3
       
      Ta macro recherche des réponses dans toutes les feuilles de mon programme et pas uniquement sur la feuille de travail.
      0
  2. Gyrus Messages postés 3360 Statut Membre 526
     
    Pour que la recherche soit effectuée seulement dans la feuille active :
    Sub Test()
    Dim Mot As String, Msg_Titre As String, Msg_Init As String, Msg_Corps As String, Adresse_Début As String
    Dim Ws As Worksheet
    Dim Cel As Range
    Dim Nbre As Long
    'Définition de la variable à rechercher
    Mot = InputBox("Saisir le N° de fiche à chercher.", Title:="Recherche")
    'Vérification si existante
    If Mot = "" Then Exit Sub
    Msg_Titre = "RECHERCHE"
    Msg_Init = "Fiche recherchée : " & Mot & Chr(10) & Chr(10) & "Nombre de fiches trouvées : "
    Msg_Corps = "Emplacement :" & Chr(10)
    With ActiveSheet
    Set Cel = .Columns(15).Find(Mot, , xlValues, xlWhole)
    If Not Cel Is Nothing Then
    Adresse_Début = Cel.Address
    Do
    Msg_Corps = Msg_Corps & "Feuille " & .Name & " : " & Cel.Address(0, 0) & Chr(10)
    Nbre = Nbre + 1
    Set Cel = .Columns(15).FindNext(Cel)
    Loop While Not Cel Is Nothing And Cel.Address <> Adresse_Début
    End If
    End With
    If Nbre > 0 Then
    MsgBox Msg_Init & Nbre & Chr(10) & Chr(10) & Msg_Corps, vbOKOnly, Msg_Titre
    Else
    MsgBox "Aucune fiche trouvée.", , " Message "
    End If
    End Sub

    A+
    0
    1. volfoss Messages postés 43 Statut Membre 3
       
      J'ai modifier ma macro avec ton aide (je préfère avoir le résultat sous cette forme plutôt que le résultat donné par ta macro).
      J'ai deux soucis:
      1- si je ne choisi pas en début de macro ma feuille de travail la ligne de mon résultat trouvé est surligné en vert sur les deux feuilles en même temps
      2- si je défini une seule feuille de travail (par ex mâles) ma macro fonctionne parfaitement pour un numéro de fiche contenu dans dans cette fiche et également pour un numéro qui n'existe pas du tout mais elle ne fait rien si le numéro se trouve sur l'autre feuille inactive (femelles) alors qu'elle devrait m'indiquer que la fiche n'existe pas.

      Puis-je encore te solliciter ?

      Ma macro :

      Dim Mot As String
      Dim Ws As Object
      Dim Nbre As Long
      Dim Cycle As Long
      Dim Trouvé As Variant
      Dim CellAddress As Variant
      Dim MyValue As String


      Worksheets("Mâles").Select

      'remets colonne O en blanc
      Columns("O:O").Select
      With Selection.Interior
      .Pattern = xlNone
      .TintAndShade = 0
      .PatternTintAndShade = 0
      End With
      'remet colonne O ligne titre en gris
      Range("O1:O3").Select
      With Selection.Interior
      .Pattern = xlSolid
      .PatternColorIndex = xlAutomatic
      .ThemeColor = xlThemeColorDark1
      .TintAndShade = -0.249946592608417
      .PatternTintAndShade = 0
      End With

      'Définition de la variable à rechercher
      Mot = InputBox("Saisir le N° de fiche à chercher.", Title:="Recherche")
      'Vérification si existante
      If Mot = "" Then Exit Sub
      For Each Ws In Worksheets
      Nbre = Nbre + Application.CountIf(Ws.UsedRange, "=" & Mot)
      Next Ws
      'Message en cas de mot inexistant
      If Nbre = 0 Then
      MyValue = MsgBox(" La fiche " & Mot & " n'est pas enregistrée ", vbOKOnly, " Message ")
      Else
      Cycle = 0
      'Recherche et arrêt sur les cellules contenant le Mot
      For Each Ws In Worksheets
      With ActiveSheet
      .Activate
      Set Trouvé = .Columns(15).Find(Mot, , xlValues, xlWhole)
      If Not Trouvé Is Nothing Then
      CellAddress = Trouvé.Address
      Do
      Trouvé.Activate
      MyValue = MsgBox(" La fiche " & Mot & " a été trouvée ", vbOKOnly, " Message ")
      'colorier la case du résultat en vert
      With Selection.Interior
      .PatternColorIndex = xlAutomatic
      .Color = 5296274
      .TintAndShade = 0
      .PatternTintAndShade = 0
      End With
      Exit Sub
      If MyValue = vbNo Then Exit For
      Set Trouvé = .Columns(15).FindNext(After:=Trouvé)
      Loop While Not Trouvé Is Nothing And Trouvé.Address <> CellAddress
      End If
      End With
      Next Ws
      End If
      0
      1. Gyrus Messages postés 3360 Statut Membre 526 > volfoss Messages postés 43 Statut Membre
         
        Bonjour,

        Moi, j'ai un seul souci, c'est que je ne parviens pas à comprendre ce que tu souhaites faire.
        La macro ne me suffit pas. Il me faudrait le fichier et quelques explications sur la finalité du traitement.

        Tu peux joindre le fichier en utilisant https://www.cjoint.com/

        A+
        0
      2. volfoss Messages postés 43 Statut Membre 3 > Gyrus Messages postés 3360 Statut Membre
         
        Il s'agit d'un programme de gestion d'élevage d'oiseaux. J'ai une feuille avec un listing des mâles et ma macro permet d'effectuer une recherche suivant le numéro de fiche de l'oiseau. Chaque numéro est unique.
        Actuellement ma macro me permet de rechercher la fiche et se positionne dans la cellule recherchée et surligne la cellule en vert. Tout ceci se réinitialise lors d'une nouvelle recherche.
        Le soucis est le suivant:
        si je tape un numéro de fiche qui se trouve sur la feuille "mâles" tout fonctionne il me le recherche
        si je tape un numéro de fiche inexistant il me l'indique également
        si je tape un numéro de fiche se trouvant sur la feuille "femelles" il ne m'indique rien alors que j'aimerais qu'il m'indique fichier inexistant dans cette feuille
        Et inversement si je suis sur la feuille "femelles" par rapport aux fiches se trouvent sur la feuille "mâles".

        J'ai essayer de lancer la macro en activant simultanément les feuilles "mâles" et "femelles" mais dans ce cas ci sur chaque feuille la même ligne est surlignée, donc sur une feuille le résultat est bon et sur l'autre au lieu de ne rien avoir on as un résultat faux.

        http://www.cjoint.com/c/FHcskoGC3h0
        0
      3. Gyrus Messages postés 3360 Statut Membre 526 > volfoss Messages postés 43 Statut Membre
         
        Bonjour,

        Avec un fichier et quelques explications, tout devient plus simple (même le code).
        https://www.cjoint.com/c/FHdhPu87EsH

        A+
        0
      4. volfoss Messages postés 43 Statut Membre 3 > Gyrus Messages postés 3360 Statut Membre
         
        ok
        merci pour tout
        0