私はゆっくりと VBA を学んでおり、自分自身を助けるために巡回セールスマン問題のバージョンに取り組んでいます。この特定のケースでは、セールスマンは 2 地点間で可能な限り長いルートを選択して、都市から都市へと移動します。ルートは、デカルト座標とユークリッド距離を使用して計算されます。この特定の例では、以下の座標の表があります。
City X Y
1 2 4
2 5 3
3 6 1
4 2 3
5 1 2
6 3 6
7 3 8
8 2 6
9 7 6
10 3 3
これに対する私のコードは以下の通りです。
Option Explicit
Sub newTSP()
Dim nCities As Integer
Dim distance() As Single
Dim wasVisited() As Boolean
Dim route() As Integer
Dim totalDistance As Single
Dim step As Integer
Dim nowAt As Integer
Dim nextAt As Integer
Dim minDistance As Single 'TODO remove this
Dim maxDistance As Single 'just to use in the distance loop
Dim i As Integer, j As Integer
Dim x1 As Integer, x2 As Integer, y1 As Integer, y2 As Integer
Dim temp_dist As Single
Dim coords As Range 'this is the table of coordinates
'my Euclidean distance array
'count number of cities in the cartesian coordinates matrix
nCities = Range(TSP.Range("a3").Offset(1, 0), TSP.Range("a3").Offset(1, 0).End(xlDown)).Rows.Count
'now that we know the number of cities, redimension distance array
ReDim distance(1 To nCities, 1 To nCities)
'take the coordinates as a range
Set coords = Range(TSP.Range("a3"), TSP.Range("a3").End(xlDown)).Resize(, 3)
'put in the first arm of the matrix
TSP.Range("e3") = "City"
TSP.Range("e3").Font.Bold = True
TSP.Range("e1") = "Distance Matrix"
TSP.Range("e1").Font.Bold = True
With TSP.Range("e3")
For i = 1 To nCities
.Offset(i, 0) = i
.Offset(i, 0).Font.Bold = True
Next
'second arm of the matrix
For j = 1 To nCities
.Offset(0, j) = j
.Offset(0, j).Font.Bold = True
Next
'fill it in with distances
For i = 1 To nCities
For j = 1 To nCities
'the default value is 0
If i = j Then
TSP.Range("e3").Offset(i, j) = 0
'otherwise look for euclidean distance
Else
'search for the coordinates for each value
x1 = WorksheetFunction.VLookup(i, coords, 2, False) 'x of i
y1 = WorksheetFunction.VLookup(i, coords, 3, False) 'y of i
x2 = WorksheetFunction.VLookup(j, coords, 2, False) 'x of j
y2 = WorksheetFunction.VLookup(j, coords, 3, False) 'y of j
temp_dist = Sqr(((x1 - x2) ^ 2) + ((y1 - y2) ^ 2))
TSP.Range("e3").Offset(i, j) = temp_dist
End If
Next
Next
End With
'Array where route will be stored. Starts and ends in City 1
ReDim route(1 To nCities + 1)
route(1) = 1
route(nCities + 1) = 1
'Boolean array indicating whether each city was already visited or not. Initialize all cities (except City 1) to False
ReDim wasVisited(1 To nCities)
wasVisited(1) = True
For i = 2 To nCities
wasVisited(i) = False
Next
'Total distance traveled is initially 0. Initial current city is City 1
totalDistance = 0
nowAt = 1
'Find at each step the FARTHEST not-yet-visited city
For step = 2 To nCities
'initialize maxDistance to 0
maxDistance = 0
For i = 2 To nCities
If i <> nowAt And Not wasVisited(i) Then
If distance(nowAt, i) > maxDistance Then
nextAt = i
maxDistance = TSP.Range("e3").Offset(nowAt, i)
'TODO: does this distance call work with the new table format?
End If
End If
Next i
'store the next city to be visited in the route array
route(step) = nextAt
wasVisited(nextAt) = True
'update total distance travelled
totalDistance = totalDistance + maxDistance
'update current city
nowAt = nextAt
Next step
'Update total distance traveled with the distance between the last city visited and the initial city, City 1.
totalDistance = totalDistance + distance(nowAt, i) 'TODO: does this call work? Original had it as 1, not i.
'Print Results
With TSP.Range("A3").Offset(nCities + 2, 0)
.Offset(0, 0).Value = "Nearest neighbor route"
.Offset(1, 0).Value = "Stop #"
.Offset(1, 1).Value = "City"
For step = 1 To nCities + 1
.Offset(step + 1, 0).Value = step
.Offset(step + 1, 1).Value = route(step)
Next step
.Offset(nCities + 4, 0).Value = "Total distance is " & totalDistance
End With
End Sub
私の行「wasVisited(nextAt) = True」で問題が発生しているようです。ここでは、添え字が範囲外になります。添え字は、i = 1 から nCities の範囲内にしっかりと収まっている必要があります。よくわかりません私の問題はどこから来ているのですか？