我正在慢慢学习 VBA，并且正在研究旅行商问题的一个版本来帮助自己。在这种特殊情况下，销售员通过选择两点之间可能的最长路线从一个城市移动到另一个城市。路线是使用笛卡尔坐标和欧几里得距离计算的。对于这个特定的例子，我有下面的坐标表：
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 的范围内，我不确定我的问题来自哪里。有什么想法吗？