Sub GPE() Dim Query As String
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
With cn
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
ThisWorkbook.FullName _
& ";Extended Properties=""Excel 12.0 Xml;HDR=NO;IMEX=1"";"
.Open
End With
Query = "SELECT A.f1, Sum(f6 * B.f3) "
Query = Query & "From (Select *, iif(B.f2 >= A.f2,A.f2 - B.f1,B.f2 - B.f1) as f6 From [A2:B6] as A "
Query = Query & "Left Join [D2:F6] as B on A.f2 > B.f1 ) as C Group by A.f1"
rs.Open Query, cn
Range("K2").CopyFromRecordset rs
rs.Close: cn.Close: Set rs = Nothing: Set cn = Nothing
End Sub