Recherche de plusieurs valeurs en faction de plusieurs critères Résolu/Fermé

Question

Bonjour, 

Je débute sur VBA et pour l'instant, je tâtonne beaucoup. 
Dans un fichier Excel A, j'ai entre autres 2 colonnes : nom et prénom. Je dois retrouver les formations suivies par chaque personne. Ces formations sont stockées dans un fichier B en lignes sous la forme Nom/Prénom/Formation. Donc si une personne a suivie 4 formations, il y a 4 lignes pour son nom.
Dans le fichier A, je dois ramener les 3 premières formations en colonnes, c'est-à-dire Nom/Prénom/Formation 1/Formation 2/Formation 3 en faisant la recherche sur le couple nom/prénom.

Est-ce que quelqu'un voit comment faire?
Merci pour votre aide




Configuration: Windows 7 / Chrome 54.0.2840.71

ThauTheme · Answer

Bonsoir Ielosub (Marine ?) , bonsoir le forum,

Le code ci-dessous considère que les connées se trouvent dans le premier onglet de chaque classeur et qu'elles commencent dans la cellule A1. Sinon il faudra adapter... 
Tu dois le placer dans le classeur A qui, par conséquent, prendra  l'extension xlsm si tu as une version d'Excel après 2003. 
il faut que les deux classeurs soient au préalablement ouverts avant de lancer la macro.
Vérifie et/ou adapte les noms des classeurs...

Le code:

Sub Macro1()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TS As Variant 'déclare la variable TS (Tableau Source)
Dim TD As Variant 'déclare la variable TD (Tableau Detination)
Dim I As Long 'déclare la variable I (Incrément)
Dim J As Long 'déclare la variable J (incrément)
Dim DEST As Range 'déclare la variable DEST (crellule de DESTination)

Set CS = Workbooks("Classeur B.xlsx") 'définit le classeur source CS (à adapter)
Set OS = CS.Worksheets(1) 'définit l'onglet source OS (à adapter)
Set CD = Workbooks("Classeur A.xlsm") 'définit le classeur destination CD (à adapter)
Set OD = CD.Worksheets(1) 'définit l'onglet destination OD (à adapter)
TS = OS.Range("A1").CurrentRegion 'définit le tableau source TS
TD = OD.Range("A1").CurrentRegion 'définit le tableau destination TD
For I = 1 To UBound(TD, 1) 'boucle 1 : sur toutes les lignes I du tableau destination TD
    For J = 1 To UBound(TS, 1) 'boucle 2 : sur toutes les lignes J du tableau source TS
        If TD(I, 1) & TD(I, 2) = TS(J, 1) & TS(J, 2) Then
        'condition : si la donnée ligne I colonne 1 concatenée avec la donnée lige I colonne 2 de TD est égale
        'à la donnée ligne J colonne 1 concaténée à la donnée ligne J colonne 2 de TS
            Set DEST = OD.Cells(I, Application.Columns.Count).End(xlToLeft).Offset(0, 1)
            'définit la cellule de destination DEST
            DEST.Value = TS(J, 3) 'renvoie dans DEST la valeur de la donnée ligne J colonne 3 de TS
        End If 'fin de la condition
    Next J 'prochaine ligne de la boucle 2
Next I 'prochaine ligne de la boucle 1
End Sub

Recherche de plusieurs valeurs en faction de plusieurs critères

1 réponse

Discussions similaires