Greedy Heuristic i VBA
Hej eksperter!Jeg er ved at skrive en såkaldt "Greedy Heuristic" i VBA, men er desværre ikke ekspert i VBA.
Problemet består af, at jeg har 35 kunder, som jeg skal besøge. Essensen af heuristikken er, at jeg starter ved det første punkt, som er depotet/lageret. Herfra besøger jeg kontinuerligt den nærmeste kunde, indtil jeg har besøgt hver kunde præcis 1 gang.
Problem er at heuristikken laver en rute for de første 35 kunder, men undlader at besøge 3 af mine kunder. Jeg er overbevist om, at det har noget at køre med, hvordan jeg har defineret mine for loops og mine ranges, men jeg har ikke selv kunnet finde frem til fejlen.
Jeg er klar over at problemet er lidt kompliceret, når man ikke har dataet, men alt hjælp er påskønnet! :-)
På forhånd, tak for hjælpen.
Med venlig hilsen
Alexander
Min afstandsmatrix starter i celle C4. Jeg kan desværre ikke vedhæfte billeder, men jeg prøver ved at kopiere min VBA kode i stedet:
Public Sub MyNearestNeighbor()
Dim n As Integer
Dim dist As Double 'cummulated dist
Dim A() As Double ' current best
Dim i As Integer
Dim j As Integer
Dim used() As Integer
Dim d As Double ' distance at current node
Dim best As Integer 'best customer
Dim rng As Range
Workbooks("NearestNeighbour TSP.xlsm").Activate
ThisWorkbook.Worksheets("Rejseafstand i km").Range("C4").Activate
n = ActiveCell.CurrentRegion.Rows.Count - 1
ReDim A(n) 'set dimension of best(36)
ReDim used(n) 'set dimension of used (36)
dist = 0 'set cummulated dist to 0 to begin with
'Prepare used - Start from 0
For i = 4 To n - 1
used(i) = 0
Next
A(0) = Cells(4, 3) 'starting point i.e., depot
used(0) = 1
For i = 4 To n - 1 'Include all except the depot
' Find nearest:
d = 1000000.9 ' "a big-M inspired constraint"
For j = 1 To n - 1
If used(j) = 0 And Cells(4 + A(i), j + 3) < d Then
' better found
best = j
d = Cells(4 + A(i), j + 3)
End If
Next
' best is now the nearest
A(i) = best
used(best) = 1
dist = dist + d
Next
' ' Back to home
A(n) = Cells(4, 3)
dist = dist + Cells(4 + A(n - 1), 3 + A(n))
