Public Sub Step(R As Range, Target As Range)
Dim A(1 To 100, 1 To 100) As Variant, S(1 To 100) As String, V(1 To 100) As String, ASum(1 To 100) As Variant

    
    RCC = R.Columns.Count - 1
    RRC = R.Rows.Count - 1
    For i = 1 To RRC
        V(i) = R.Cells(i + 1, 1).Value
    Next i
    For j = 1 To RCC
        S(j) = R.Cells(1, j + 1).Value
    Next j
    For j = 1 To RCC
        For i = 1 To RRC
            A(i, j) = R.Cells(i + 1, j + 1).Value
        Next i
    Next j
    
    
    Do While RRC > 0 And RCC > 0
    
    For j = 1 To RCC
        ASum(j) = 0
        For i = 1 To RRC
            ASum(j) = ASum(j) + A(i, j)
        Next i
    Next j
     
    JMax = 0
    AMax = 0
    For j = 1 To RCC
        If ASum(j) > AMax Then
            AMax = ASum(j)
            JMax = j
        End If
    Next j
    
    MinMax = 100000
    For i = 1 To RRC
        If A(i, JMax) < MinMax Then
            MinMax = A(i, JMax)
            IMax = i
        End If
    Next i
    
    Counter = Counter + 1
    
    Target.Cells(Counter, 1).Value = V(IMax)
    Target.Cells(Counter, 2).Value = S(JMax)
    
    For i = IMax To RRC - 1
        For j = 1 To RCC
            A(i, j) = A(i + 1, j)
        Next j
        V(i) = V(i + 1)
    Next i
    RRC = RRC - 1
    
    For j = JMax To RCC - 1
        For i = 1 To RRC
            A(i, j) = A(i, j + 1)
        Next i
        S(j) = S(j + 1)
    Next j
    RCC = RCC - 1
     
Loop
    
End Sub

Public Sub StepCall()
    Call Step(Range("A1:F5"), Range("P2"))
    Range("P2:Q5").Select
    ActiveWorkbook.Worksheets("Ëèñò2").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Ëèñò2").Sort.SortFields.Add Key:=Range("P2"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Ëèñò2").Sort
        .SetRange Range("P2:Q5")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Sub otvet()
Application.ScreenUpdating = False
Dim vak%, isk%, i%, j%, tik%, num1%, num2%, i_row%, i_col%
Dim MyArr() As String, Arr(), s_isk() As String, sum()

vak = 4 'количество вакансий
isk = 5 'количество соискателей

ReDim MyArr(1 To vak, 1 To 2)
For i = 1 To vak
MyArr(i, 1) = Cells(i + 1, 1)
Next i

ReDim s_isk(1 To isk)
For i = 1 To isk
s_isk(i) = Cells(1, i + 1)
Next i

ReDim Arr(1 To isk, 1 To vak)
For i = 1 To vak
For j = 1 To isk
Arr(j, i) = Cells(i + 1, j + 1)
Next j
Next i

ReDim sum(1 To isk)

Do
tik = tik + 1

For i = 1 To isk
sum(i) = 0
Next i

For i = 1 To isk
For j = 1 To vak
sum(i) = sum(i) + Arr(i, j)
Next j
Next i

num1 = 0
For i = 1 To isk
If sum(i) >= num1 Then
num1 = sum(i)
i_row = i
End If
Next i

num2 = Application.Max(sum) + 1

For i = 1 To vak
If Arr(i_row, i) < num2 And Arr(i_row, i) <> 0 Then
num2 = Arr(i_row, i)
i_col = i
End If
Next i

MyArr(i_col, 2) = s_isk(i_row)

For i = 1 To vak
Arr(i_row, i) = 0
Next i

For i = 1 To isk
Arr(i, i_col) = 0
Next i

Loop While tik < vak

For i = 1 To vak
Cells(i + 1, 9) = MyArr(i, 1)
Cells(i + 1, 10) = MyArr(i, 2)
Next i

Application.ScreenUpdating = True
End Sub