Option Explicit
Option Base 1

Sub Rio_Dij()
     Dim StartX As Long
     Dim FinishX As Long
     Dim BasE, NamS
     Dim nCost, nBack, nBack_tmp
     Dim i As Long
     Dim j As Long
     Dim k As Long
     Dim l As Long
     Dim SumX As Double
     Dim MinX As Double
     Dim MinID
     Dim Result() As String
     Dim RowA As Long
     Dim RowB As Long
     RowA = Cells(5, 1).End(xlDown).Row - 4
     RowB = RowA + 1
     Range(Cells(4, RowA + 3), Cells(4, RowA + 3).End(xlToRight).End(xlDown)).Clear
     MinX = 999999999999999#
     BasE = Range("B5").Resize(RowA, RowA)
     NamS = Range("A5").Resize(RowA, 1)
     For i = 1 To RowA
         If Range("B2").Value = NamS(i, 1) Then StartX = i
         If Range("E2").Value = NamS(i, 1) Then FinishX = i
     Next i
     ReDim nCost(RowA)
     ReDim nBack(RowA)
     ReDim nBack_tmp(RowA)
     For i = 1 To UBound(NamS, 1)
         nCost(i) = MinX
         nBack(i) = RowB
         nBack_tmp(i) = RowB
     Next i
     nCost(StartX) = 0
     nBack(StartX) = 0
     Do While nBack(FinishX) = RowB
         For i = 1 To RowA
             If nBack(i) < RowB Then
                 For j = 1 To RowA
                     If BasE(i, j) > 0 Then
                         SumX = nCost(i) + BasE(i, j)
                         If nCost(j) > SumX Then
                             nCost(j) = SumX
                             nBack_tmp(j) = i
                         End If
                     End If
                 Next j
             End If
         Next i
         MinX = 999999999999999#
         For i = 1 To RowA
             If nBack(i) <> nBack_tmp(i) Then
                 If nCost(i) < MinX Then
                     MinX = nCost(i)
                     MinID = i
                 End If
             End If
         Next i
         nBack(MinID) = nBack_tmp(MinID)
     Loop
     i = FinishX
     j = 0
     Do
         j = j + 1
         ReDim Preserve Result(4, j)
         Result(1, j) = NamS(nBack(i), 1) 'Откуда
         Result(2, j) = NamS(i, 1) 'Куда
         Result(3, j) = BasE(nBack(i), i) 'Сколько стоило
         Result(4, j) = nCost(i) 'Стоимость накопительно
         i = nBack(i)
     Loop While i <> StartX
     Range("A4").Offset(0, RowA + 2).Resize(1, 5).Value = Array("Шаг", "Откуда", "Куда", "Сумма", "Накопительно")
     For k = j To 1 Step -1
         Cells(5 + (j - k), RowA + 3).Value = j - k + 1
         For l = 1 To 4
             Cells(5 + (j - k), RowA + 3 + l).Value = Result(l, k)
         Next l
     Next k
End Sub