Sub mrshkei()
Dim sh As Worksheet, sh2 As Worksheet, arr, arr2, arr3
Dim i As Long, n As Long, k As Long, lr As Long, lr2 As Long
Set sh = Worksheets("Новая_партия"): Set sh2 = Worksheets("Старая_партия")
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row: lr2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row
arr = sh.Range("A1:J" & lr): arr2 = sh2.Range("A1:I" & lr2): ReDim arr3(1 To UBound(arr), 1 To 2)

For i = LBound(arr) + 1 To UBound(arr)
k = 0
    For n = LBound(arr2) + 1 To UBound(arr2)
        If arr(i, 1) = arr2(n, 1) Then
        k = k + 1
        If arr(i, 7) - arr2(n, 7) <> 0 Then
            arr3(i - 1, 1) = "да"
            arr3(i - 1, 2) = "Изменение объема"
            Exit For
        Else
            arr3(i - 1, 1) = Empty
            arr3(i - 1, 2) = Empty
        End If
        End If
        If k = 0 Then
            arr3(i - 1, 1) = "да"
            arr3(i - 1, 2) = "новая позиция"
        End If
    Next n
Next i

sh.Range("I2").Resize(UBound(arr3), 2) = arr3
End Sub