Sub ОгурцовыйПрайс()
    Dim ar1 As Variant: ar1 = Range("B3:C9")
    Dim ar2 As Variant: ar2 = Range("F3:G9")
    
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    JobArr ar1, dic
    JobArr ar2, dic
    
    With Range("I3")
        .Cells(1, 1).Resize(dic.Count, 1) = Application.Transpose(dic.Keys())
        .Cells(1, 2).Resize(dic.Count, 1) = Application.Transpose(dic.Items())
    End With
End Sub

Sub JobArr(arr As Variant, dic As Object)
    Dim y As Long
    For y = 1 To UBound(arr, 1)
        If Not dic.Exists(arr(y, 1)) Then
            dic.Item(arr(y, 1)) = arr(y, 2)
        Else
            If dic.Item(arr(y, 1)) < arr(y, 2) Then
                dic.Item(arr(y, 1)) = arr(y, 2)
            End If
        End If
    Next
End Sub

I2 и ниже        =ЕСЛИ(СТРОКА()<СЧЁТЗ(B:B)+2;B3;ВПР(СТРОКА()-СЧЁТЗ(B:B)-1;D:G;3;0))
J2 и ниже        =МАКС(ЕСЛИОШИБКА(ВПР(I3;B:C;2;0);0);ЕСЛИОШИБКА(ВПР(I3;F:G;2;0);0))
D2 и ниже        =D2+1-СЧЁТЕСЛИМН(B:B;F3)