Recopie de valeurs selon un horaire correspondant à chacune

Option Explicit

Const SpotFileName = "Spot CAC40 2506-0207 v1.xls"
Const SpotSheetName = "Rapport1"
Const FinalSheetName = "FINAL"

Sub MAC_Copy_valueCAC()

Dim refRg As Range, RefValues(), NewValues
Dim Nrow, i, D, T, D_T, Y
Dim topN As Long, middleN As Long, bottomN As Long
   
   'tri des données du fichier SPOT
   With Workbooks(SpotFileName).Sheets(SpotSheetName)
      Set refRg = .Cells(.Rows.Count, "b").End(xlUp).Offset(, 4)
      Set refRg = .Range(.Cells(3, "b"), refRg)
      refRg.Sort key1:=refRg(1, 1), order1:=xlAscending, key2:=refRg(1, 2), _
                  order2:=xlAscending, Header:=xlYes
      'récupération des données du fichier SPOT
      Set refRg = refRg.Offset(1).Resize(refRg.Rows.Count - 1)
      RefValues = refRg.Value
   End With
   
   'Si la date ou heure est du texte, on transforme en date et heure
   For i = LBound(RefValues) To UBound(RefValues)
      If VarType(RefValues(i, 1)) = vbString Then RefValues(i, 1) = DateValue(RefValues(i, 1))
      If VarType(RefValues(i, 2)) = vbString Then RefValues(i, 2) = TimeValue(RefValues(i, 2))
      RefValues(i, 3) = RefValues(i, 1) + RefValues(i, 2)
   Next i
   
   With ThisWorkbook.Sheets(FinalSheetName)
      Nrow = .Cells(.Rows.Count, "a").End(xlUp).Row
      'tableau du résultats
      ReDim NewValues(2 To Nrow)
      For i = 2 To Nrow
         'Calcul de la clef
         D = .Cells(i, "a")
         T = .Cells(i, "e")
         If VarType(D) = vbString Then D = DateValue(D)
         If VarType(T) = vbString Then T = TimeValue(T)
         If Second(T) <= 29 Then
            D_T = D + TimeSerial(Hour(T), Minute(T), 0)
         Else
            D_T = D + TimeSerial(Hour(T), Minute(T), 30)
         End If
         'recherche par dichotomie dela clef dans RefValues
         topN = UBound(RefValues): bottomN = LBound(RefValues)
         Do
            middleN = (topN + bottomN) / 2
            If D_T > RefValues(middleN, 3) Then bottomN = middleN + 1 Else topN = middleN - 1
         Loop Until (D_T = RefValues(middleN, 3)) Or (bottomN > topN)
         If D_T = RefValues(middleN, 3) Then NewValues(i) = RefValues(middleN, 5) Else NewValues(i) = ""
      Next i
      
      'Affichage du résultat dans la colonne H
      .Cells(2, "h").Resize(Nrow - 1).Value = Application.Transpose(NewValues)
   End With
End Sub

Sub PC_Copy_valueCAC()

Dim Dict, RefValues(), NewValues
Dim Nrow, i, D, T, D_T

   Set Dict = CreateObject("Scripting.Dictionary")
   
   With Workbooks(SpotFileName).Sheets(SpotSheetName)
      RefValues = .Range(.Cells(5, "b"), .Cells(Rows.Count, "b").End(xlUp)).Resize(, 5).Value
      For i = LBound(RefValues) To UBound(RefValues)
         Dict.Add RefValues(i, 1) + TimeValue(RefValues(i, 2)), RefValues(i, 5)
      Next i
   End With
   
   With ThisWorkbook.Sheets(FinalSheetName)
      Nrow = .Cells(.Rows.Count, "a").End(xlUp).Row
      ReDim NewValues(2 To Nrow)
      For i = 2 To Nrow
         D = .Cells(i, "a")
         T = .Cells(i, "e")
         If Second(T) <= 29 Then
            D_T = D + TimeSerial(Hour(T), Minute(T), 0)
         Else
            D_T = D + TimeSerial(Hour(T), Minute(T), 30)
         End If
         If Dict.Exists(D_T) Then NewValues(i) = Dict.Item(D_T)
      Next i
      .Cells(2, "h").Resize(Nrow - 1).Value = Application.Transpose(NewValues)
   End With
End Sub