Sub Макрос1()

    Dim arr(), lr As Long, i As Long, j As Long
    
    Application.ScreenUpdating = False
    
    lr = Columns("A:B").Find(What:="*", LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False _
        , SearchFormat:=False).Row
    arr() = Range("A1:A" & lr).Value
    
    For i = 1 To UBound(arr, 1)
    
        If (IsNumeric(arr(i, 1)) = False) Or (IsEmpty(arr(i, 1)) = True) Then
            GoTo metka
        End If
        
        For j = i + 1 To UBound(arr, 1)
            If (IsNumeric(arr(j, 1)) = True) And (IsEmpty(arr(j, 1)) = False) Then
                If arr(i, 1) + arr(j, 1) = 0 Then
                    arr(i, 1) = Empty
                    arr(j, 1) = Empty
                    Exit For
                End If
            End If
        Next
metka:
    Next
    
    Range("A1").Resize(UBound(arr, 1), 1).Value = arr()
    
    On Error Resume Next
    Range("A1").Resize(UBound(arr, 1), 1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    On Error GoTo 0
    
    Application.ScreenUpdating = True
    
    MsgBox "Готово!", vbInformation
    
End Sub