求A点到B点之间最短的一条路线(看谁速度最快)

dcw0402

功力不足,慢慢消化

jrllchuan

学习了，好东西！

大灰狼1976

用水管方法就可解决，虽然还没有试过，不过如果30000行时，路径不是太多的话，10秒内应该能出结果吧。

大灰狼1976

有兴趣的朋友可以试着做下欧拉计划第83题，我可以在0.1秒完成，没有借鉴任何其他人的任何方法。

paciguard

留个脚印，学习一下。。。。

yynrzwh

Sub 最短路径10()
    Dim tm As Double, n As Long, k As Long
    Dim stack As Collection ' 用于迭代模拟栈的集合
    Dim visited() As Boolean '标记格子是否已访问
    Dim tx(), ty(), ar, tar
    Dim row As Long, col As Long, steps As Long
    Dim i As Long, x As Long, y As Long
   
    tm = Timer
    n = [ag1]
    tar = Range("a1").Resize(n + 2, 31).value
    ar = tar
    tx = Array(0, 1, 0, -1)
    ty = Array(1, 0, -1, 0)
    k = 1
    ar(2, 2) = k
   
    ' 初始化栈，并将起始位置压入栈中
    Set stack = New Collection
    stack.Add Array(2, 2, k)
    ReDim visited(1 To n + 2, 31)
   
    Do While stack.count > 0
        ' 弹出栈顶元素
        arr = stack(1)
        stack.Remove 1
        row = arr(0): col = arr(1): steps = arr(2)
        ar(row, col) = steps
        ' 遍历四个方向
        For i = 0 To 3
            x = row + tx(i): y = col + ty(i)
            ' 检查是否到达终点
            If ar(x, y) = "B" Then Exit Do
            ' 将新位置压入栈中
            If ar(x, y) = -1 And Not visited(x, y) Then
                stack.Add Array(x, y, steps + 1)
                visited(x, y) = True
            End If
        Next i
    Loop
   
    ' 输出路径
    Dim r As Long, c As Long, p As Long, xP As Long, yP As Long
    r = n + 1: c = 2
    tar(r, c) = 0
    Do
        For p = 0 To 3
            xP = r + tx(p)
            yP = c + ty(p)
            If ar(xP, yP) = ar(r, c) - 1 Then
                r = xP: c = yP
                tar(xP, yP) = 0
                Exit For
            End If
        Next p
    Loop Until r = 2 And c = 2 ' 起点是(2,2)
   
    Range("a1").Resize(UBound(tar), UBound(tar, 2)) = tar
    MsgBox "最少步数：" & steps & "步,耗时" & Format(Timer - tm, "0.00s")
End Sub