很多路线里面,选择最短的路线

pliuyu

就是通过一个矩阵输入数据,然后可以计算出任意两点之间的最短路程,请各位指教!

Sub Button1_Click()
    Dim i, j, k, n
   
    Dim dist(n, n)
    Dim P(n, n)
   
    ActiveWorkbook.Sheets("Input").Activate
    n = ActiveWorkbook.Sheets("Input").Cells(1, 8).Value
   
    'Clear output sheet
    For i = 1 To 20
        For j = 1 To 20
            Sheets("Output").Cells(3 + i, 1 + j).Value = Null
            Sheets("Routes").Cells(3 + i, 1 + j).Value = Null
        Next j
    Next i
   
    'Copy weights to output sheet
    For i = 1 To n
        For j = 1 To n
            dist(i, j) = Sheets("Input").Cells(3 + i, 1 + j)
            If Sheets("Input").Cells(3 + i, 1 + j).Value = "" Then
                dist(i, j) = 10 ^ 15
            Else
                P(i, j) = i
            End If
        Next j
        dist(i, i) = 0
    Next i

    'Run algorithm
    Sheets("Output").Activate
        nchanges = 1
        While nchanges > 0
        nchanges = 0
        For i = 1 To n
            For j = 1 To n
            For k = 1 To n
                If dist(i, j) > (dist(i, k) + dist(k, j)) Then
                    dist(i, j) = dist(i, k) + dist(k, j)
                    P(i, j) = k
                    nchanges = nchanges + 1
                End If
                Next k
            Next j
        Next i
        Wend
        

   
   
        For i = 1 To n
        For j = 1 To n
            Sheets("Output").Cells(3 + i, 1 + j).Value = dist(i, j)
            If Sheets("Input").Cells(3 + i, 1 + j).Value = "" Then
                Sheets("Output").Cells(3 + i, 1 + j).Value = 10 ^ 15
            Else
                Sheets("Routes").Cells(3 + i, 1 + j).Value = i
            End If
        Next j
        Sheets("Output").Cells(3 + i, 1 + i).Value = 0
    Next i

End Sub

Sub FindRoute()
    Sheets("Routes").Activate
    Source = ActiveCell.Row - 3
    Destination = ActiveCell.Column - 1
    Value = ActiveCell.Value
    If (Source = Value) Then
        MsgBox "Go from " & Source & " to " & Destination
    Else
        MsgBox "Go from " & Source & " to " & Value
        Cells(Value + 3, Destination + 1).Select
        Call FindRoute
    End If
End Sub

雁南飞81

天那，我什么时候能看懂

pliuyu

相应的算法以及VB代码.

Public Function Floyd()
    Dim i As Long, j As Long, k As Long
    '初始化
    For i = 1 To N
        For j = 1 To N
            D(i, j) = A(i, j)
        Next j
    Next i
    For i = 1 To N
        For j = 1 To N
            P(i, j) = 0
        Next j
    Next i
    For i = 1 To N
        For j = 1 To N
            If D(i, j) < INF Then     'J是I的后继点
                P(i, j) = j
            End If
        Next j
    Next i
   
    '迭代N次     
    For k = 1 To N
        For i = 1 To N
            For j = 1 To N
                If D(i, k) + D(k, j) < D(i, j) Then
                    D(i, j) = D(i, k) + D(k, j)
                    P(i, j) = P(i, k)
                End If
            Next j
        Next i
    Next k
End Function