Résultat dans colonne et pas ligne

Pierre -  
Frenchie83 Messages postés 2254 Statut Membre -
Bonjour,
merci pour ce travaille super et j'aimerais savoir dans la fonction recherchVpolyvalente trouver sur ce site que faut il changer pour que les résulats soit horizontal ?je ne trouve pas dans la macro les changements a effectuer? 

Option Explicit

'RD =cellule où commencer la recherche
'RC = cellule critère
'RDT = cellule où chercher la donnée
'Ligne rechercher jusque ligne... (optional) si 0 cherche jusqu'au bout de la ligne

Public Function RechercheVmulti(RD As Range, RC As Range, RDT As Range, _
            Optional Ligne As Long = 0)

Dim i As Integer, e As Integer, Txt As String
Dim LigE As Long, ColE As Long 'où écrire résultats
Dim Col As Integer
Dim Lig As Long, Occ As Long
Dim FeuilE As String, FeuilRD As String, FeuilRDT As String

    On Error GoTo sortie
    LigE = Application.Caller.Row
    ColE = Application.Caller.Column
    FeuilE = Application.Caller.Parent.Name
    Application.Volatile
    Lig = RD.Row ' Ligne où commencer la recherche
    Col = RD.Column 'Colonne où commencer la recherche
    FeuilRD = RD.Parent.Name
    FeuilRDT = RDT.Parent.Name
    If Ligne = 0 Then
        Ligne = Range(Sheets(FeuilRD).Cells(65536, Col), Sheets(FeuilRD).Cells(65536, Col)).End(xlUp).Row
    End If
    'Recherche le numéro de l'occurrence à trouver
    For Occ = LigE - 1 To 1 Step -1
        Txt = Sheets(FeuilE).Cells(Occ, ColE).Formula
        If Txt = Sheets(FeuilE).Cells(LigE, ColE).Formula Then
            e = e + 1
        End If
    Next Occ
    For i = Lig To Ligne
        If Sheets(FeuilRD).Cells(i, Col) = RC Then
            If e <> 0 Then
                e = e - 1
            Else
                RechercheVmulti = Sheets(FeuilRDT).Cells(i, RDT.Column)
                Exit Function
            End If
        End If
    Next i
    'Si plus trouvé de concordance
    RechercheVmulti = ""
Exit Function
sortie:
    'si erreur dans la formule, non détectée par Excel.
    RechercheVmulti = "#FAUTE!"
End Function

EDIT: Ajout de la coloration syntaxique.

Merci de votre aide
Pierre

5 réponses

  1.
    Frenchie83 Messages postés 2254 Statut Membre 339
     
    Bonjour
    Difficile de vous aider sans voir la construction de votre fichier.
    Cependant je vous propose ceci sans garantie du fonctionnement
    A tester 
    'RD =cellule où commencer la recherche
'RC = cellule critère
'RDT = cellule où chercher la donnée
'Colonne rechercher jusque Colonne... (optional) si 0 cherche jusqu'au bout de la Colonne

Public Function RechercheHmulti(RD As Range, RC As Range, RDT As Range, Optional Colonne As Long = 0)
    Dim i As Integer, e As Integer, Txt As String
    Dim LigE As Long, ColE As Long 'où écrire résultats
    Dim Col As Integer
    Dim Lig As Long, Occ As Long
    Dim FeuilE As String, FeuilRD As String, FeuilRDT As String
    
    On Error GoTo sortie
    LigE = Application.Caller.Row
    ColE = Application.Caller.Column
    FeuilE = Application.Caller.Parent.Name
    Application.Volatile
    Lig = RD.Row ' Colonne où commencer la recherche
    Col = RD.Column 'Colonne où commencer la recherche
    FeuilRD = RD.Parent.Name
    FeuilRDT = RDT.Parent.Name
    If Colonne = 0 Then
        Colonne = Range(Sheets(FeuilRD).Cells(Lig, 1000), Sheets(FeuilRD).Cells(Lig, 1000)).End(xlToLeft).Column
    End If
    'Recherche le numéro de l'occurrence à trouver
    For Occ = ColE - 1 To 1 Step -1
        Txt = Sheets(FeuilE).Cells(LigE, Occ).Formula
        If Txt = Sheets(FeuilE).Cells(LigE, ColE).Formula Then
            e = e + 1
        End If
    Next Occ
    For i = Col To Colonne
        If Sheets(FeuilRD).Cells(Lig, i) = RC Then
            If e <> 0 Then
                e = e - 1
            Else
                RechercheHmulti = Sheets(FeuilRDT).Cells(RDT.Row, i)
                Exit Function
            End If
        End If
    Next i
    'Si plus trouvé de concordance
    RechercheHmulti = ""
    Exit Function
sortie:
    'si erreur dans la formule, non détectée par Excel.
    RechercheHmulti = "#FAUTE!"
End Function

    Cdlt
    0
  2. Pierre
     
    désolé de ma réponse tardive..je teste delà et je reviens vers vous

    Merci
    0
  3. Pierre
     
    Bonjour

    Alors j'ai pu vérifier mais en faite ma demande était que les résulat s'affiche en ligne

    je m'explique dans mon fichier plus haut les résultat s'affiche dans les cellule ou ce trouve ma fonction mais les cellule doivent être en collonne. ici j'aimerais que ma fonction soit sur une ligne que les résultat de la recherche ce place en ligne
    0
    1. Frenchie83 Messages postés 2254 Statut Membre 339
       
      Bonjour
      Pour nous faciliter la tâche, pouvez-vous fournir un extrait de votre fichier sans données confidentielles, avec des commentaires sur les résultats attendus?
      merci
      cdlt
      0
  4. pierre
     
    Merci de votre réponse voici un fichier pour voir plus clair, enfin j'espère
    en clo A vous avez les donné recherché en col B les donné qui sont exrait en col C le critére pour le moment avec la fonction rechecherv polyvalente les résultat ne s'affiche que verticalement mais si je copie la fonction horizontelement celà ne va pas j'ai mis en jaune la zon ou je voudrais les résultats merci de votre aide

    lien du fichier
    http://www.cjoint.com/c/EFEfiGgW0lW
    0

  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. Frenchie83 Messages postés 2254 Statut Membre 339
     
    Bonjour
    Remplacer ces 2 lignes 
       
 LigE = Application.Caller.Row
 ColE = Application.Caller.Column

    par 
    ColE = Application.Caller.Column
LigE = ColE - 2

    cdlt
    0