|
Liebe Community,
ich sitze momentan vor einem kleinen Problem, da ich mich wenig mit VBA bzw. programmierung im Allgemeinen auskenne aber einen 2-opt Algorithmus im Rahmen eines TSP anwenden muss. Auf meiner Suche im Internet hat ich folgenden Code gefunden, welche für ein symmetrisches TSP geschreiben wurde. Leider verstehe ich nicht, was ich mach muss um dieses Code auf ein asymmetrisches TSP umzuschreiben und wie ich meine "Daten" implementieren kann. Es wäre nett, wenn ihr mir helfen könntet. Folgend der Code und meine Distanzmatrix:
0 1 2 3 4 5 6 7 8 9 10 11 12 13
0 0 30,3 24,7 23,8 23,3 27,3 22,5 22,7 24 24,8 25 30,1 27,2 24,2
1 30,8 0 1,2 1,9 3,1 3,3 4 4,3 4,5 5,3 4,5 1,3 2,4 5,9
2 25 1,8 0 1,1 2,1 2,7 3,6 3,9 4,1 4,9 4,8 1,6 2,6 5,5
3 23,7 2,2 0,8 0 1,2 1,9 2,6 2,9 3,1 4,2 4 2,3 2,3 4,7
4 22,8 3,4 2,2 1,4 0 1 1,7 2 2,1 3,6 3,4 2,9 2,6 4,1
5 23,7 3,6 2,2 1,8 0,9 0 1,4 1,7 1,9 3 2,9 2,8 2,1 3,6
6 22,5 4,9 3,8 3 2,4 2,1 0 1,1 1,6 4,9 4,8 4,7 3,9 3,8
7 22,8 6,2 5,1 4,2 3,7 3,5 1,1 0 1,2 3,3 3,1 6,3 5,3 2,6
8 24 5,2 4,1 3,3 2,6 2 1,5 1,6 0 3,9 3,8 4,5 3,7 3,4
9 24,4 5,3 5 4,2 3,4 2,5 3,5 3,4 2,3 0 0,21 4,4 2,4 1,6
10 24,2 5,5 5 4,2 3,6 2,3 3,3 3,2 2,1 1,2 0 4,6 2,5 1,9
11 30,3 2,5 2,5 2,3 2,5 2,7 3,4 3,8 3,9 4,7 4 0 1,9 5,3
12 29,4 3,5 3,1 2,9 3,1 4,3 4 5,5 4,4 3 2,3 2,4 0 3,8
13 25 5,9 5,9 4,9 4 3 4,1 3 2,9 0,6 0,85 5 3 0
Sub ZweiOptAlgo()
Dim i As Byte
Dim j As Byte
Dim n As Integer
Dim lzaehler As Byte
Dim m As Byte
'Entfernungsmatrix einlesen
For j = 1 To 11
For i = 1 To 11
mEntfernungsmatrix(i, j) = Cells(1 + i, 1 + j)
'Cells(i + 12, 1 + j) = mZeitenmatrix(i, j) --> nur zum Überprüfen
Next
Next
'Startlösung einlesen
n = Range("n3").CurrentRegion.Rows.Count
ReDim mStartloesung(n + 1) As Integer
For lzaehler = 1 To n
mStartloesung(lzaehler) = Cells(2 + lzaehler, 14)
Next
mStartloesung(n + 1) = 1
' Start des Algorithmus
Zeilenmarke:
For i = 1 To (n - 2)
For j = i + 2 To n
If (mEntfernungsmatrix(mStartloesung(i), mStartloesung(i + 1)) + mEntfernungsmatrix(mStartloesung(j), mStartloesung(j + 1))) > (mEntfernungsmatrix(mStartloesung(i), mStartloesung(j)) + mEntfernungsmatrix(mStartloesung(i + 1), mStartloesung(j + 1))) Then
ReDim mNeueLoesung(n + 1)
For lzaehler = 1 To (n + 1)
mNeueLoesung(lzaehler) = mStartloesung(lzaehler)
Next
m = j - i
For lzaehler = 1 To m
mNeueLoesung(i + lzaehler) = mStartloesung(j - (lzaehler - 1))
Next
For lzaehler = 1 To (n + 1)
mStartloesung(lzaehler) = mNeueLoesung(lzaehler)
Next
Exit For
Exit For
GoTo Zeilenmarke
End If
Next
Next
For lzaehler = 2 To (n)
Cells(20 + lzaehler, 17) = mStartloesung(lzaehler)
Next
End Sub
Vielen Dank!
|