XL 2016 Utiliser un dictionary pour extraire des données

[KTM]

Bonsoir chers tous
Dans mon fichier joint je voudrais extraire et stocker dans ma colonne AY les anciens protocoles existants en colonne AP selon les codes
J'ai adapté une macro mais qui apparemment coince un peu.
Un expert en l'usage des dictionary pourrait il me venir en aide ?
Merci

 

[Bebere]

Bonjour
Ktm à tester

Sub extraire()
Dim dico As New Dictionary, datader&, data
Dim resultder&, result, i&, clef, deb, x
    Application.ScreenUpdating = False
   Set dico = CreateObject("scripting.dictionary")
   dico.CompareMode = 1
  
   If Me.FilterMode Then Me.ShowAllData
   datader = Cells(Rows.Count, "AO").End(xlUp).Row
   data = Cells(2, "AO").Resize(datader, 2)
  
   resultder = Cells(Rows.Count, "AT").End(xlUp).Row
   result = Range(Cells(2, "AT"), Cells(resultder, "AY")) '.Resize(resultder, 6)
   'code et ancien protocole
   For i = 1 To UBound(data): dico(data(i, 1) & " " & data(i, 2)) = data(i, 1) & " " & data(i, 2): Next
   For Each clef In dico.Keys
   For i = 1 To UBound(result)
   x = Mid(clef, 1, InStr(clef, " ") - 1)
  If result(i, 1) = x Then
  result(i, 6) = Mid(clef, InStr(clef, " ") + 1)
  End If
   Next
   Next clef
   Cells(2, "AT").Resize(UBound(result, 1), UBound(result, 2)) = result
   Set dico = Nothing
End Sub

 

[KTM]

Bonjour
Ktm à tester

Sub extraire()
Dim dico As New Dictionary, datader&, data
Dim resultder&, result, i&, clef, deb, x
    Application.ScreenUpdating = False
   Set dico = CreateObject("scripting.dictionary")
   dico.CompareMode = 1

   If Me.FilterMode Then Me.ShowAllData
   datader = Cells(Rows.Count, "AO").End(xlUp).Row
   data = Cells(2, "AO").Resize(datader, 2)

   resultder = Cells(Rows.Count, "AT").End(xlUp).Row
   result = Range(Cells(2, "AT"), Cells(resultder, "AY")) '.Resize(resultder, 6)
   'code et ancien protocole
   For i = 1 To UBound(data): dico(data(i, 1) & " " & data(i, 2)) = data(i, 1) & " " & data(i, 2): Next
   For Each clef In dico.Keys
   For i = 1 To UBound(result)
   x = Mid(clef, 1, InStr(clef, " ") - 1)
  If result(i, 1) = x Then
  result(i, 6) = Mid(clef, InStr(clef, " ") + 1)
  End If
   Next
   Next clef
   Cells(2, "AT").Resize(UBound(result, 1), UBound(result, 2)) = result
   Set dico = Nothing
End Sub

M E R C I

un dernier détail : j'aimerais mettre 0 si code non trouvé dans la plage source

 

[mapomme]

Bonsoir KTM,

mapomme t'avais déjà fait une version ICI qui met des zéros si le code recherché est absent.
Pourquoi ne pas l'avoir repris ?
A part le changement des colonnes concernées, tout était fait.

 

[KTM]

Bonsoir KTM,

mapomme t'avais déjà fait une version ICI qui met des zéros si le code recherché est absent.
Pourquoi ne pas l'avoir repris ?
A part le changement des colonnes concernées, tout était fait.

Ok merci

 

[KTM]

Bonsoir KTM,

mapomme t'avais déjà fait une version ICI qui met des zéros si le code recherché est absent.
Pourquoi ne pas l'avoir repris ?
A part le changement des colonnes concernées, tout était fait.

Beau essayé mais je m'en sors pas !