XL 2016 Utiliser un dictionary pour extraire des données

Bebere à dit:

Bonjour
Ktm à tester

VB:

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

Cliquez pour agrandir...

mapomme à dit:

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.

Cliquez pour agrandir...

mapomme à dit:

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.

Cliquez pour agrandir...