Discussion :

[Malfudan]

Bonjour à tous ,

Cela fait quelques années je n'ai pas posté mais là je cale.
J'essaie de créer un fichier pour me faire gagner énormément de temps dans lequel je souhaite insérer une macro, mon but est:

- de lancer une macro dans un "tableau A" en cliquant sur l'entête de la colonne "donnée Importé" FAIT

- que la macro ouvre le navigateur pour aller cibler un 2ème fichier ou se trouve un "tableau B" et l'ouvre FAIT

- qu'une recherche soit faite entre les données dans le "tableau A" et le "tableau B" : à faire
"type" (du tableau A) = nom de l'onglet (du tableau B)
"nom" (du tableau A) = "nom" (du tableau B)
"ref" (du tableau A ecrit en 1,2,3...) = "ref" (du tableau B écrit en 001,002,003...) conversion à faire

- Que si une correspondance est trouvée dans les données alors la donnée dans la colonne "Valeur à récupérer" du "Tableau B" soit copier et collée dans la colonne "donnée Importée" du "tableau A" à faire

Tableau A:

Tableau B:


Contraintes::
- Le fichier contenant le "tableau B" ne peut pas changer de format (onglet/tableau..)
- Des doublons peuvent être présent dans le "tableau A" ce qui sous entends une recherche ligne par ligne

Je n'ai pas eu trop de problème à faire la première partie mais j'avoue ne pas vraiment savoir comment m'y prendre (au vue de mon niveau actuel) pour toute la partie recherche et transfert de la donnée, entre le fait de faire le lien entre le contenu d'une cellule et le nom d'un onglet / la conversion de num type 1,10,100 en 001,010,100 et la recherche dans tout le doc via une boucle je présume.

Je me doute que pour la plupart des codeurs aguerris cela ne représente pas forcement un gros défis et je fais donc appel à vos compétences pour m'aider à faire aboutir ma macro :-).
Merci par avance pour la lecture et encore plus pour une aide éventuelle.
Bonne journée

[Thautheme]

Bonjour Malfudan et bienvenu, bonjour le forum

Essaie comme ça (à adapter) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TD As ListObject 'déclare la variable TD (Tableau Destination)
Dim PD As Range 'déclare la variable PD (Plage Destination)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OD (Onglet Source)
Dim TS As ListObject 'déclare la variable TS (Tableau Source)
Dim PS As Range 'déclare la variable PS (Plage Source)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
 
Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CS.Worksheets(1) 'définit l'onglet destination OD (ici le premier onglet, à adapter à ton cas)
Set TD = OD.ListObjects(1) 'définit le tableau destination TD (ici le premier tableau, à adapter à ton cas)
Set PD = TD.DataBodyRange 'définit la plage destination PD
Set OS = worksbooks("Ton_Classeur_Source.xlsx") 'définit le classeur source (comme tu n'a pas fourni ton code du adapteras cette variable)
For I = 1 To PD.Rows.Count 'boucle 1 : sur toutes les lignes I de la plage destination PD
    Set OS = CS.Worksheets(PD(I, 2)) 'définit l'onglet source OS
    Set TS = OS.ListObjects(1) 'définit le tableau source (ici le premier tableau, à adapter à ton cas)
    Set PS = TS.DataBodyRange 'définit la plage source PS
    For J = 1 To PS 'boucle 2 : sur toutes les lignes J de la plage source PD
        'condition : si la donnée ligne J colonne 1 de PS correspond à la donnée ligne I colonne 1 de PD
        'et si la donnée ligne J colonne 2 de PS (convertie en entier) correspond à la donnée ligne I colonne 3 de PD
        If PS(J, 1) = PD(I, 1) And CInt(PS(J, 2).Value) = PD(I, 3) Then
            'renvoie la donnée ligne J colonne 3 de PS dans la cellule ligne I, colonne 6 de PD, sort de la boucle
            PD(I, 6).Value = PS(J, 3).Value: Exit For
        End If 'fin de la sélection
    Next J 'prochaine ligne de la boucle 2
Next I 'prochaine ligne de la boucle 1
End Sub

[Malfudan]

Merci beaucoup Thautheme de ton retour 😁. Je vais regarder cela en détail et tester ce soir en adaptant. Je posterais le code une fois que j’aurais réussis à faire marcher l’ensemble en adaptant :-)

[Malfudan]

Bonjour Malfudan et bienvenu, bonjour le forum

Essaie comme ça (à adapter) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TD As ListObject 'déclare la variable TD (Tableau Destination)
Dim PD As Range 'déclare la variable PD (Plage Destination)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OD (Onglet Source)
Dim TS As ListObject 'déclare la variable TS (Tableau Source)
Dim PS As Range 'déclare la variable PS (Plage Source)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
 
Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CS.Worksheets(1) 'définit l'onglet destination OD (ici le premier onglet, à adapter à ton cas)
Set TD = OD.ListObjects(1) 'définit le tableau destination TD (ici le premier tableau, à adapter à ton cas)
Set PD = TD.DataBodyRange 'définit la plage destination PD
Set OS = worksbooks("Ton_Classeur_Source.xlsx") 'définit le classeur source (comme tu n'a pas fourni ton code du adapteras cette variable)
For I = 1 To PD.Rows.Count 'boucle 1 : sur toutes les lignes I de la plage destination PD
    Set OS = CS.Worksheets(PD(I, 2)) 'définit l'onglet source OS
    Set TS = OS.ListObjects(1) 'définit le tableau source (ici le premier tableau, à adapter à ton cas)
    Set PS = TS.DataBodyRange 'définit la plage source PS
    For J = 1 To PS 'boucle 2 : sur toutes les lignes J de la plage source PD
        'condition : si la donnée ligne J colonne 1 de PS correspond à la donnée ligne I colonne 1 de PD
        'et si la donnée ligne J colonne 2 de PS (convertie en entier) correspond à la donnée ligne I colonne 3 de PD
        If PS(J, 1) = PD(I, 1) And CInt(PS(J, 2).Value) = PD(I, 3) Then
            'renvoie la donnée ligne J colonne 3 de PS dans la cellule ligne I, colonne 6 de PD, sort de la boucle
            PD(I, 6).Value = PS(J, 3).Value: Exit For
        End If 'fin de la sélection
    Next J 'prochaine ligne de la boucle 2
Next I 'prochaine ligne de la boucle 1
End Sub

Bonjour Thautheme, j'ai essayé d'intégrer ton code en l'adaptant à la mise en forme de mes tableaux, en voici le code qui ne marche pas pour le moment, le code bloque à

Set OS = CS.Worksheets(PD(I, 2))

:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
 
Sub Import()
Dim CD As Workbook                      'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet                     'déclare la variable OD (Onglet Destination)
Dim TD As ListObject                    'déclare la variable TD (Tableau Destination)
Dim PD As Range                         'déclare la variable PD (Plage Destination)
Dim CS As Workbook                      'déclare la variable CS (Classeur Source)
Dim OS As Worksheet                     'déclare la variable OS (Onglet Source)
Dim TS As ListObject                    'déclare la variable TS (Tableau Source)
Dim PS As Range                         'déclare la variable PS (Plage Source)
Dim I As Integer                        'déclare la variable I (Incrément)
Dim J As Integer                        'déclare la variable J (incrément)
 
                                        'MsgBox Oui + Non
Select Case MsgBox("Voulez vous mettre à jour le nombre de jours étoile de l'industriel?", vbYesNo + vbQuestion, "Confirmation")
Case vbYes                              'si réponse oui à la messagebox
 
Set CD = ThisWorkbook                   'définit le classeur destination CD
Set OD = CD.Worksheets("Modèle")        'définit l'onglet destination OD (ici le premier onglet) AAAAAAAAAAAA rediriger de manière dynamique en le nommant
Set TD = OD.ListObjects(1)              'définit le tableau destination TD (ici le "tableau 1")AAAAAAAAAAAA rediriger de manière dynamique
Set PD = TD.DataBodyRange               'définit la plage destination PD (ici la plage active de la liste definit au dessus)
Set CS = Workbooks("TESTINDUS.xlsx")    'définit le classeur source AAAAAAAAAA rediriger vers le chemin definit via GetOpenFilename
For I = 1 To PD.Rows.Count              'boucle 1 : sur toutes les lignes I de la plage destination PD
    Set OS = CS.Worksheets(PD(I, 2))    'définit l'onglet source OS
    Set TS = OS.ListObjects(1)          'définit le tableau source (ici le premier tableau) AAAAAAAAAAAA rediriger de manière dynamique sans passer par le tableau mais une plage définit en remontant
    Set PS = TS.DataBodyRange           'définit la plage source PS
    For J = 1 To PD.Rows.Count          'boucle 2 : sur toutes les lignes J de la plage source PD
        'condition : si la donnée ligne J colonne 1 de PS correspond à la donnée ligne I colonne 1 de PD
        'et si la donnée ligne J colonne 2 de PS (convertie en entier) correspond à la donnée ligne I colonne 3 de PD
        If PS(J, 5) = PD(I, 3) And CInt(PS(J, 6).Value) = PD(I, 4) Then
            'renvoie la donnée ligne J colonne 3 de PS dans la cellule ligne I, colonne 6 de PD, sort de la boucle
            PD(I, 39).Value = PS(J, 38).Value: Exit For
        End If                          'fin de la sélection
    Next J                              'prochaine ligne de la boucle 2
Next I                                  'prochaine ligne de la boucle 1
 
Case vbNo                               'si réponse non à la messagebox
End Select                              'fin du msgbox
 
End Sub

- Si je remplace le PD(I, 2) qui pose problème par le nom d'un onglet (en mettant "AVG" par exemple), la macro ne bloque plus mais à la fin de celle ci aucune données n'est copié de PS ligne J colonne 38 vers PD ligne I colonne 39.

- Si je comprends bien dans les lignes suivantes on cible le 1er "objet" de l'onglet, à savoir le tableau, je souhaiterais définir moi même la plage car le tableau source de donnée contiens un bon paquet d'objets

Set TS = OS.ListObjects(1) 'définit le tableau source (ici le premier tableau) AAAAAAAAAAAA rediriger de manière dynamique sans passer par le tableau mais une plage définit en remontant
Set PS = TS.DataBodyRange 'définit la plage source PS

- Enfin dans la ligne suivante on fait référence à 2 conditions hors la 2ème ce compose comme cela : 20-077 -> 20 (dans CS) correspondant à l'année 2020 dans CD et 077 (dans CS) correspondant à la valeur 077

If PS(J, 5) = PD(I, 3) And CInt(PS(J, 6).Value) = PD(I, 4) Then

Il faut donc convertir en 2 partie le contenu de la cellule mais je n'arrive pas à intégrer la formule gauche ou droite qui à mon avis serait le plus simple à greffé sur le code que tu m'a fournit.

J'ai essayé de faire mon exemple au plus simple sans prendre toutes les données en compte pour pouvoir comprendre plus facilement le code mais là je ne comprends pas pourquoi le PD(I, 2) ne marche pas, cela doit être une erreur de ma part ou une formulation erronée (pour info je suis sous Excel 2016).

Je continue bien évidement à fouiller de mon côté :-).

[Thautheme]

Re,

Je ne peux rien de plus sans les fichiers qui vont bien. Je sais que ce n'est pas dans l'éthique de ce forum mais je n'ai pas le niveau suffisant pour me contenter de simple captures d'écran. Pourtant j'assure bien sur PhotoChope...

[Malfudan]

Re,

Je ne peux rien de plus sans les fichiers qui vont bien. Je sais que ce n'est pas dans l'éthique de ce forum mais je n'ai pas le niveau suffisant pour me contenter de simple captures d'écran. Pourtant j'assure bien sur PhotoChope...

Bonjour Thautheme, je comprends tout à fait, j'ai recréé des fichiers épurés de données correspondants aux fichiers utilisés :-). C'est plus pratique qu'avec PhotoChope

TABDESTINATION.xlsm
TABSOURCE.xlsm

Merci de m'accorder du temps.

[Thautheme]

Re,

je regarde ça se soir et reviens vers toi...

[Édition]
Le code modifié :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Sub Import()
Dim CD As Workbook                      'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet                     'déclare la variable OD (Onglet Destination)
Dim TD As ListObject                    'déclare la variable TD (Tableau Destination)
Dim PD As Range                         'déclare la variable PD (Plage Destination)
Dim CS As Workbook                      'déclare la variable CS (Classeur Source)
Dim OS As Worksheet                     'déclare la variable OS (Onglet Source)
Dim PS As Range                         'déclare la variable PS (Plage Source)
Dim I As Integer                        'déclare la variable I (Incrément)
Dim J As Integer                        'déclare la variable J (incrément)
Dim A As Integer                        'déclare la variable A (Année)
Dim N As Integer                        'déclare la variable N (Numéro)
 
 
'si "Non" au mnessage, sort de la procédure
If MsgBox("Voulez vous mettre à jour le nombre de jours étoile de l'industriel?", vbYesNo + vbQuestion, "Confirmation") = vbNo Then Exit Sub
Set CD = ThisWorkbook                                                 'définit le classeur destination CD
Set OD = CD.Worksheets("Modèle")                                      'définit l'onglet destination OD
Set TD = OD.ListObjects(1)                                            'définit le tableau destination TD
Set PD = TD.DataBodyRange                                             'définit la plage destination PD
Set CS = Workbooks("TABSOURCE.xlsm")                                  'définit le classeur source
For I = 1 To PD.Rows.Count                                            'boucle 1 : sur toutes les lignes I de la plage destination PD
    Set OS = CS.Worksheets(PD(I, 2).Value)                            'définit l'onglet source OS
    Set PS = OS.Range("A3").CurrentRegion                             'définit la plage source PS
    For J = 2 To PS.Rows.Count                                        'boucle 2 : sur toutes les lignes J de la plage source PS
        If PS(J, 5) = PD(I, 3) Then                                   'condition : si la donnée ligne J colonne 5 de la plage PS est égale à la donnée ligne I colonne 3 de la plage PD
            A = Year(DateSerial(CInt(Split(PS(J, 6), "-")(0)), 1, 1)) 'définit l'année A
            N = CInt(Split(PS(J, 6), "-")(1))                         'définit le numéro N
                                                                      'si la donnée ligne I colonne 5 de la plage PD (convertie en entier) est égale à A et si la donnée ligne I colonne 4 de la plage PD (convertie en entier) est égale à N
                                                                      'renvoie la donnée ligne J colonne 39 de la plage PS dans la cellule ligne I colonne 38 de la plage PD, sort de la boucle 2
            If CInt(PD(I, 5)) = A And CInt(PD(I, 4)) = N Then PD(I, 38).Value = PS(J, 39).Value: Exit For
        End If                                                        'fin de la condition
    Next J                                                            'prochaine ligne de la boucle 2
Next I                                                                'prochaine ligne de la boucle 1
End Sub

Il est regrettable que les fichiers ne correspondent pas à l'exemple initial. On ne fait que perdre du temps...