Sub Adaptation()
Dim TDon(), L As Long, DicTot As New Dictionary, DicFml As Dictionary, _
TK(), N As Long, Atom As String, TAtom()
TDon = Feuil2.[B3].Resize(Feuil2.[B1000000].End(xlUp).Row - 2).Value
For L = 1 To UBound(TDon, 1)
Set DicFml = DicAtomes(TDon(L, 1))
TK = DicFml.Keys
For N = 0 To UBound(TK)
Atom = TK(N)
DicTot(Atom) = DicTot(Atom) + DicFml(Atom)
Next N, L
TAtom = Feuil2.[E2:E10].Value
For L = 1 To UBound(TAtom, 1): TAtom(L, 1) = DicTot(TAtom(L, 1)): Next L
Feuil2.[F2:F10].Value = TAtom
End Sub