Thema Datum  Von Nutzer Rating
Antwort
Rot 2-opt Algorithmus VBA
04.08.2016 21:40:04 Ludwig
*****
NotSolved
08.08.2016 09:52:47 Ludwig
NotSolved

Ansicht des Beitrags:
Von:
Ludwig
Datum:
04.08.2016 21:40:04
Views:
1419
Rating: Antwort:
  Ja
Thema:
2-opt Algorithmus VBA

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!


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot 2-opt Algorithmus VBA
04.08.2016 21:40:04 Ludwig
*****
NotSolved
08.08.2016 09:52:47 Ludwig
NotSolved