sub M_Doober()
    Dim Sh As Worksheet, Sh1 As Worksheet, kol As Integer, Art As String
    Set Sh = ThisWorkbook.Worksheets("ИП")
    Set Sh1 = ThisWorkbook.Worksheets("Результат")
    Sh1.UsedRange.ClearContents
    LastRow = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row
    dx = Sh.Range("A1:G" & LastRow)
    With CreateObject("scripting.dictionary")
        For n = 2 To UBound(dx)
            If dx(n, 5) <> "" Then
                If dx(n, 5) < 0 Then
                    kol = Abs(dx(n, 5))
                    For i = n + 1 To UBound(dx)
                        If dx(i, 7) > kol Then
                            Art = dx(i, 2)
                            .Item(Art) = kol
                            Exit For
                        End If
                    Next
                End If
            End If
        Next
        keys = .keys
        If .Count > 0 Then
            Sh1.Range("a2").Resize(.Count, 2) = Application.Transpose(Array(.keys, .Items))
        End If
    End With
End Sub