XL pour MAC Remplir automatiquement des colonnes à partir d’un autre classeur.

[Cortomaltese]

Bonjour à tous
J’ai deux classeurs :
Le premier comprend une liste de centaines de livres et une liste d’auteurs

Le second comprend environ 60.000 lignes avec plusieurs occurrences récurrentes de ces centaines de livres

J’ai besoin de remplir automatiquement ces 60.000 lignes du second avec les correspondances des auteurs du premier classeur :

Merci pour vos lumières
Corto

 

[vgendron]

Bonjour

Plutot que des images qui sont inutilisables, peux tu poster tes fichiers (pas besoin de mettre toutes les lignes)

 

[nat54]

Bonjour,

Exemple en PJ (bon j'ai tout mis dans un fichier mais ça ne change rien)

 

[vgendron]

ce code à placer dans un module standard de ton classeur à remplir

regarde les commentaires

Sub Correspondances()
Set dico = CreateObject("Scripting.dictionary")
Dim TabSource() As Variant
Dim TabFinal() As Variant
Dim WbSource As Workbook
Dim WbDest As Workbook
Dim WsSource As Worksheet
Dim WsDest As Worksheet

'on défini le classeur actif
Set WbDest = ActiveWorkbook
Set WsDest = ActiveSheet
fin = WsDest.Range("A" & Rows.Count).End(xlUp).Row 'dernière ligne de la colonne A

TabFinal = WsDest.Range("A1:B" & fin).Value 'on met 2 colonnes dans un tableau vba


'ouvrir classeur source
nomClass = Application.GetOpenFilename()
Workbooks.Open Filename:=nomClass

Set WbSource = ActiveWorkbook
Set WsSource = ActiveSheet
'récuperer les données dans un tableau
TabSource = WsSource.UsedRange.Value

For i = LBound(TabSource, 1) To UBound(TabSource, 1) 'pour chaque ligne
    If Not dico.exists(TabSource(i, 1)) Then 'on créé une entrée dictionnaire avec l'auteur comme valeur
        dico.Add TabSource(i, 1), TabSource(i, 2)
    End If
Next i

WbSource.Close savechanges:=False 'on peut fermer le fichier source sans sauvegarde


For i = LBound(TabFinal, 1) To UBound(TabFinal, 1) 'pour chaque ligne
    TabFinal(i, 2) = dico(TabFinal(i, 1)) 'on affecte l'auteur
Next i

WsDest.Range("A1").Resize(UBound(TabFinal, 1), 2) = TabFinal 'on colle le résultat
End Sub

 

[Cortomaltese]

Un immense merci à tous pour vos réponses pertinentes et parfaitement fonctionnels !