Dois-je faire une "Loop" en VBA ou une formule ???

Sub EXTRACTION1()
Dim oPlg As Range, dPlg As Range
  Set oPlg = Me.[A1] 'première cellule de la plage de données.
  Set dPlg = Me.[C1] 'première cellule de la plage de destination.
  toto2 oPlg, dPlg 'appelle la procédure d'extraction proprement dite.
  'Cette façon de faire permet d'adapter facilement le code à d'autres
  'configuration. il suffit de modifier la définition de oPlg et dPlg.
End Sub

Sub toto2(oPlg As Range, dPlg As Range)
Dim i&, d&, dMin&, dMax&, tmp&, oColl As New Scripting.Dictionary
  dMin = 2958465  '31/12/9999
  dMax = 0        '01/01/1900
'
'Recherche des dates extrêmes dMin et dMax dans la colonne commençant à la cellule oPlg
  i = 0
  Do Until IsEmpty(oPlg.Offset(i, 0))
    If IsDate(oPlg.Offset(i, 0)) Then
      tmp = oPlg.Offset(i, 0).Value
      dMin = (dMin + tmp - Math.Abs(tmp - dMin)) / 2
      dMax = (dMax + tmp + Math.Abs(tmp - dMax)) / 2
    End If
    i = i + 1
  Loop
'
'Création de la liste ordonnée oColl de toutes les dates de dMin à dMax
  For d = dMin To dMax: oColl.Add d, 0: Next
'
'Association des données de la deuxième colonne la plage associée à de oPlg aux dates
'correspondantes dans oColl
  i = 0
  Do Until IsEmpty(oPlg.Offset(i))
    If IsDate(oPlg.Offset(i)) Then oColl(CDbl(oPlg.Offset(i))) = oPlg.Offset(i, 1)
    i = i + 1
  Loop
'
'Procédure d'affichage des résultats dans la plage commençant à la cellule dPlg
  i = dPlg.Parent.Cells(dPlg.Parent.Rows.Count, dPlg.Column).End(xlUp).Row - dPlg.Row + 1
  With Application: .ScreenUpdating = 0: .Calculation = -4135: .EnableEvents = 0: End With
  dPlg.Resize(IIf(i < 1, 1, i), 2).ClearContents
  If oColl.Count Then
    With dPlg.Resize(oColl.Count)
      .NumberFormat = oPlg.NumberFormat
      .Cells = WorksheetFunction.Transpose(oColl.Keys)
    End With
    dPlg.Resize(oColl.Count).Offset(0, 1) = WorksheetFunction.Transpose(oColl.Items)
  End If
  With Application: .EnableEvents = 1: .Calculation = -4105: .ScreenUpdating = 1: End With
End Sub

Sub toto2(oPlg As Range, dPlg As Range)
Dim i&, d&, dMin&, dMax&, tmp&, oColl As Object 'New Scripting.Dictionary
  Set oColl = CreateObject("Scripting.Dictionary")
  dMin = 2958465  '31/12/9999
  dMax = 0        '01/01/1900
'
'Recherche des dates extrêmes dMin et dMax dans la colonne commençant à la cellule oPlg
  i = 0
  Do Until IsEmpty(oPlg.Offset(i, 0))
    If IsDate(oPlg.Offset(i, 0)) Then
      tmp = CDate(oPlg.Offset(i, 0).Value) '***
      dMin = (dMin + tmp - Math.Abs(tmp - dMin)) / 2
      dMax = (dMax + tmp + Math.Abs(tmp - dMax)) / 2
    End If
    i = i + 1
  Loop
'
'Création de la liste ordonnée oColl de toutes les dates de dMin à dMax
  For d = dMin To dMax: oColl.Add d, 0: Next
'
'Association des données de la deuxième colonne la plage associée à de oPlg aux dates
'correspondantes dans oColl
  i = 0
  Do Until IsEmpty(oPlg.Offset(i))
    If IsDate(oPlg.Offset(i)) Then oColl(CDate(oPlg.Offset(i))) = oPlg.Offset(i, 1) '***
    i = i + 1
  Loop
'
'Procédure d'affichage des résultats dans la plage commençant à la cellule dPlg
  i = dPlg.Parent.Cells(dPlg.Parent.Rows.Count, dPlg.Column).End(xlUp).Row - dPlg.Row + 1
  With Application: .ScreenUpdating = 0: .Calculation = -4135: .EnableEvents = 0: End With
  dPlg.Resize(IIf(i < 1, 1, i), 2).ClearContents
  If oColl.Count Then
    With dPlg.Resize(oColl.Count)
      .NumberFormat = oPlg.NumberFormat
      .Cells = WorksheetFunction.Transpose(oColl.Keys)
    End With
    dPlg.Resize(oColl.Count).Offset(0, 1) = WorksheetFunction.Transpose(oColl.Items)
  End If
  With Application: .EnableEvents = 1: .Calculation = -4105: .ScreenUpdating = 1: End With
End Sub