C THIS SUBROUTINE SOLVES THE FULL DENSITY LINEAR ASSIGNMENT PROBLEM
C ACCORDING TO 
C
C "A Shortest Augmenting Path Algorithm for Dense and Sparse Linear   
C Assignment Problems," Computing  38 ,  325 - 340 ,  1987 
C   
C by
C   
C R. Jonker and A. Volgenant, University of Amsterdam.

Sub AssignmentProblem()
Const N =  5 
Dim i&, i0&, j&, j0&, j1&, h&, k&, z&, cnt&, s$, ss$
Dim m&, m0&, v0&, vj&, dj&, up&, min&, low&, last&
Dim c&(N, N), x(N), y(N), u(N), v(N)
Dim lab&(N), d&(N), free&(N), col&(N)

For i =  1  To N
For j =  1  To N
c(i, j) = Cells(i, j)
Next j
Next i

For i =  1  To N
x(i) =  0 
Next i

For j0 =  1  To N
j = N - j0 +  1 : vj = c(j,  1 ): i0 =  1 
For i =  2  To N
If c(j, i) < vj Then vj = c(j, i): i0 = i
Next i
v(j) = vj: col(j) = j
If x(i0) =  0  Then
x(i0) = j: y(j) = i0
Else
x(i0) = - 1  * Abs(x(i0)): y(j) =  0 
End If
Next j0

m =  0 
For i =  1  To N
If x(i) =  0  Then
m = m +  1 : free(m) = i: GoTo  40 
End If
If x(i) <  0  Then
x(i) = - 1  * x(i)
Else
j1 = x(i): min =  10  ^  9 
For j =  1  To N
If j = j1 Then GoTo  31 
If c(j, i) - v(j) < min Then min = c(j, i) - v(j)

 31 
Next j
v(j1) = v(j1) - min
End If

 40 
Next i

cnt =  0 
If m =  0  Then GoTo  999 

 41 
m0 = m: k =  1 : m =  0 

 50 
i = free(k): k = k +  1 : v0 = c( 1 , i) - v( 1 )
j0 =  1 : vj =  10  ^  9 

For j =  2  To N
h = c(j, i) - v(j)
If h < vj Then
If h >= v0 Then
vj = h: j1 = j
Else
vj = v0: v0 = h: j1 = j0: j0 = j
End If
End If
Next j

i0 = y(j0)
If v0 < vj Then
v(j0) = v(j0) - vj + v0
Else
If i0 =  0  Then GoTo  43 
j0 = j1: i0 = y(j1)
End If
If i0 =  0  Then GoTo  43 
If v0 < vj Then
k = k -  1 : free(k) = i0
Else
m = m +  1 : free(m) = i0
End If

 43 
x(i) = j0: y(j0) = i
If k <= m0 Then GoTo  50 
cnt = cnt +  1 
If (m >  0 ) And (cnt <  2 ) Then GoTo  41 
m0 = m
For m =  1  To m0
i0 = free(m)
For j =  1  To N
d(j) = c(j, i0) - v(j)
lab(j) = i0
Next j

up =  1 : low =  1 

 60 
last = low -  1 : min = d(col(up)): up = up +  1 

For k = up To N
j = col(k): dj = d(j)
If dj <= min Then
If dj < min Then
min = dj: up = low
End If
col(k) = col(up): col(up) = j: up = up +  1 
End If
Next k

For h = low To up -  1 
j = col(h)
If y(j) =  0  Then GoTo  70 
Next h

 55 
j0 = col(low): low = low +  1 
i = y(j0): h = c(j0, i) - v(j0) - min

For k = up To N
j = col(k): vj = c(j, i) - v(j) - h
If vj < d(j) Then
d(j) = vj: lab(j) = i
If vj = min Then
If y(j) =  0  Then GoTo  70 
col(k) = col(up): col(up) = j: up = up +  1 
End If
End If
Next k

If low = up Then GoTo  60 
GoTo  55 

 70 
For k =  1  To last
j0 = col(k): v(j0) = v(j0) + d(j0) - min
Next k

 80 
i = lab(j): y(j) = i: k = j: j = x(i): x(i) = k
If i0 <> i Then GoTo  80 
Next m
 999 

z =  0 
s = "Номера колонок: "
ss = "Выбранные значения: "
For i =  1  To N
u(i) = c(x(i), i) - v(x(i)): z = z + c(x(i), i)
s = s & y(i) & " ": ss = ss & c(i, y(i)) & " "
Next i
Debug.Print "МинСумма: " & z & vbCrLf & s & vbCrLf & ss
MsgBox "МинСумма: " & z & vbCrLf & s & vbCrLf & ss
End Sub

University of Amsterdam.