Please, try the next approach. The following code loads the arrays containing Time, Hour and values from an Excel sheet, involved ranges looking like:
The two ranges "A2:C6", respectively, "F2:F6" will be loaded in two 2D arrays (arr1
and arr2
). They will be processed and the processing result will be placed in arrFin
. The range "J2:K8" represents the processing result:
Sub testMatchDayHourValue()
Dim sh As Worksheet, arr1, arr2, arrFin, i As Long
Dim dict As New Scripting.Dictionary
Set sh = ActiveSheet 'use here your necessary sheet
arr1 = sh.Range("A2:C6").Value 'put the range value in an array
arr2 = sh.Range("F2:H6").Value 'put the range value in an array
For i = 1 To UBound(arr1) 'iterate through the first array elements and create uniques keys
If Not dict.Exists(arr1(i, 1) & " " & Format(arr1(i, 2), "hh:mm")) Then
dict.Add arr1(i, 1) & " " & Format(arr1(i, 2), "hh:mm"), arr1(i, 3) 'the key and its initial value
Else
'add to existing value the new one, for the same existing key:
dict(arr1(i, 1) & " " & Format(arr1(i, 2), "hh:mm")) = _
dict(arr1(i, 1) & " " & Format(arr1(i, 2), "hh:mm")) + arr1(i, 3)
End If
Next
For i = 1 To UBound(arr2) 'iterate through the second array elements, create uniques keys and add values
If Not dict.Exists(arr2(i, 1) & " " & Format(arr2(i, 2), "hh:mm")) Then
dict.Add arr2(i, 1) & " " & Format(arr2(i, 2), "hh:mm"), arr2(i, 3) 'create a key if it not existing
Else
'add to existing value the new one, for the same existing key:
dict(arr2(i, 1) & " " & Format(arr2(i, 2), "hh:mm")) = _
dict(arr2(i, 1) & " " & Format(arr2(i, 2), "hh:mm")) + arr2(i, 3)
End If
Next
'combining the arrays in the final one, using a not well known method:
arrFin = Application.Transpose(Array(dict.Keys, dict.Items))
'drop the created array contents at once:
sh.Range("J2").Resize(UBound(arrFin), 2).Value = arrFin
End Sub
Please, test the way I am suggesting and send some feedback.