Mehr Geduld...
13.06.2017 13:48:34
Max2
Hallo,
es kommt nicht immer alle 5 Minuten eine Antwort...
hier wie man es in ein Blatt schreibt:
Kopiere alles in den Code eines Tabellenblattes
Der Fettmarkierte Teil, schreibt die Werte in die Tabelle
Und Nochmals... NICHT MEIN CODE!
'Dijkstra globals
Const MaxGraph As Integer = 100 'max. number of nodes in graph
Const Infinity = 1E+308
Dim E(1 To MaxGraph, 1 To MaxGraph) As Double 'the edge costs (Infinity if no edge)
Dim A(1 To MaxGraph) As Double 'the distances calculated
Dim P(1 To MaxGraph) As Integer 'the previous/path array
Dim Q(1 To MaxGraph) As Boolean 'the queue
Public Sub Dijkstra(n, start)
'simple implementation of Dijkstra's algorithm
'n = number of nodes in graph
'start = index of start node
'init distances A
For j = 1 To n
A(j) = Infinity
Next j
A(start) = 0
'init P (path) to "no paths" and Q = set of all nodes
For j = 1 To n
Q(j) = True
P(j) = 0
Next j
Do While True 'loop will exit! (see below)
'find node u in Q with smallest distance to start
dist = Infinity
For i = 1 To n
If Q(i) Then
If A(i) Infinity Then
'check if path to neighbor j via u is shorter than current estimated distance to j
alt = A(u) + E(u, j)
If alt 0
path = Format$(u) & " " & path
u = P(u)
Loop
GetPath = Format$(source) & " " & path
End If
End Function
Public Sub DijkstraTest()
'main function to solve Dijkstra's algorithm and return shortest path between
'a node and every other node in a digraph
' define problem:
' number of nodes
n = 5
' reset connection/cost per edge
For i = 1 To n
For j = 1 To n
E(i, j) = Infinity
Next j
P(i) = 0
Next i
' fill in the edge costs
E(1, 2) = 10
E(1, 3) = 50
E(1, 4) = 65
E(2, 3) = 30
E(2, 5) = 4
E(3, 4) = 20
E(3, 5) = 44
E(4, 2) = 70
E(4, 5) = 23
E(5, 1) = 6
'Solve it for every node
For v = 1 To n
Dijkstra n, v
Debug.Print "From", "To", "Cost", "Path"
For j = 1 To n
If v j Then
Cells(1, 1).Value = "From": Cells(1, 2).Value = "To"
Cells(1, 3).Value = "Cost": Cells(1, 4).Value = "Path"
Cells(j + 1, 1).Value = v
Cells(j + 1, 2).Value = j
Cells(j + 1, 3).Value = IIf(A(j) = Infinity, "---", A(j))
Cells(j + 1, 4).Value = GetPath(v, j)
End If
Next j
Next v
End Sub