Sub yyy()
    Dim objRegExp As Object, z(), j%, i%, m%, t$
    z = Range("B1:E" & Range("B" & Rows.Count).End(xlUp).Row).Value
    Set objRegExp = CreateObject("VBScript.RegExp"): objRegExp.Pattern = "\d+"
    For i = 1 To UBound(z): z(i, 4) = CInt(objRegExp.Execute(z(i, 4))(0)): Next
    With CreateObject("scripting.dictionary")
        For i = 1 To UBound(z): t = z(i, 1) & z(i, 2)
            If Not .exists(t) Then
                m = m + 1: .Item(t) = m: For j = 1 To UBound(z, 2): z(m, j) = z(i, j): Next
            Else
              z(.Item(t), 4) = z(.Item(t), 4) + z(i, 4)
            End If
        Next
   Range("I1").Resize(.Count, UBound(z, 2)) = z
   Range("L1:L" & .Count).NumberFormat = "#,##$"
  For i = 1 To .Count: Range("G" & i) = i: Next
    End With
End Sub