Option ExplicitDim arr() As Integer, res() As Integer   ‘数据数组和结果数组Dim s() As Integer  ‘模拟堆数组Dim sLen2 As Integer  ‘堆的二维长度Dim rowNum As Integer, colNum As Integer  ‘数组行数和列数Dim isTrue As Boolean ‘判断是否成功Sub main()initArrinitSmakePathIf isTrue Then    showArr res    showPath resEnd IfisTrue = FalseEnd SubSub makePath()    ReDim valin(sLen2) As Integer    Dim i, j As Integer    i = 0    Do While i <= rowNum And isTrue = False        j = 0        Do While j <= colNum And isTrue = False            If arr(i, j) = 1 Then                ‘val(row,col,nextValue,dir,order)                valin = buildVal(i, j, 2, 1, 1)                ‘s(),val(row,col,nextValue,dir,order)                push s, valin                Do While isTrue = False And s(0, 0) > 1                    Dim valOut() As Integer, x, y As Integer                    valOut = readS(s)                    Do While valOut(3) <= 4                        x = valOut(0)                        y = valOut(1)                        Select Case valOut(3)                        Case 1                            y = y + 1                        Case 2                            x = x + 1                        Case 3                            y = y - 1                        Case 4                            x = x - 1                        End Select                                                s(s(0, 0) - 1, 3) = s(s(0, 0) - 1, 3) + 1                        If x <= UBound(arr) And x >= LBound(arr) And y <= UBound(arr, 2) And y >= LBound(arr, 2) Then                            If valOut(2) = arr(x, y) And isFooted(x, y) Then                                valin = buildVal(x, y, (valOut(2) + 1) Mod 3, 1, valOut(4) + 1)                                push s, valin                                Exit Do                            End If                        End If                        valOut(3) = valOut(3) + 1                    Loop                    If valOut(3) > 4 Then                    pop s                    End If                Loop                Do While s(0, 0) > 1                    valOut = pop(s)                    res(valOut(0), valOut(1)) = valOut(4)                Loop            End If            j = j + 1        Loop        i = i + 1    LoopEnd Sub‘行号，‘列号，‘查找下一个值‘方向:1右，2下，3左，4上‘查找总数，用于判断是否全部查找完成，以及输出步骤的序列Function buildVal(ByVal i As Integer, ByVal j As Integer, ByVal nextValue As Integer, ByVal dir As Integer, ByVal order As Integer)Dim t() As IntegerReDim t(sLen2)t(0) = it(1) = jIf nextValue = http://www.mamicode.com/0 Then    t(2) = 3Else    t(2) = nextValueEnd Ift(3) = dirt(4) = orderIf order = (rowNum + 1) * (colNum + 1) Then    isTrue = TrueEnd IfbuildVal = tEnd FunctionSub initS()    sLen2 = 4    ReDim s((rowNum + 1) * (colNum + 1) + 1, sLen2)    Dim i As Integer    For i = 0 To sLen2        s(0, i) = 0    Next i    s(0, 0) = 1End SubSub initArr()rowNum = Sheets("sheet2").UsedRange.Rows.Count - 1colNum = Sheets("sheet2").UsedRange.Columns.Count - 1ReDim arr(rowNum, colNum) As IntegerDim r, c As IntegerFor r = 1 To rowNum + 1    For c = 1 To colNum + 1        arr(r - 1, c - 1) = Sheets("sheet2").Cells(r, c).Value    Next cNext rReDim res(rowNum, colNum) As IntegerEnd SubSub showPath(p() As Integer)Dim s1 As String, i As Integer, j As Integer‘删除原有数据ActiveSheet.Range("a1:az100").SelectSelection.ClearSelection.RowHeight = 15Selection.ColumnWidth = 8.43Cells(10, 10).Select‘填充步骤序列For i = 0 To rowNum    For j = 0 To colNum        ActiveSheet.Cells(i + 1, j + 1) = p(i, j)        ActiveSheet.Cells(i + 1, j + 1).ColumnWidth = 2        ActiveSheet.Cells(i + 1, j + 1).RowHeight = 15    NextNextEnd SubSub showArr(ByRef aa() As Integer)‘MsgBox ("数组内容如下：")Dim s1 As String, i As Integer, j As IntegerFor i = 0 To rowNum    For j = 0 To colNum        s1 = s1 & aa(i, j) & ","    Next    s1 = s1 & vbCrLfNextMsgBox (s1)End Sub‘判断坐标是否已经走过Function isFooted(ByVal i As Integer, ByVal j As Integer)    Dim x As Integer    Dim b As Boolean    b = True    For x = 1 To s(0, 0) - 1        If i = s(x, 0) And j = s(x, 1) Then            b = False        End If    Next x    isFooted = bEnd FunctionFunction readS(s() As Integer)    Dim arrLen As Integer, t() As Integer, i As Integer    arrLen = UBound(s, 2)    ReDim t(arrLen) As Integer    If s(0, 0) > 1 Then        For i = 0 To arrLen            t(i) = s((s(0, 0) - 1), i)        Next i    Else        For i = 0 To arrLen            t(i) = -1        Next i    End If    readS = tEnd FunctionFunction pop(s() As Integer)    Dim arrLen As Integer, t() As Integer, i As Integer    arrLen = UBound(s, 2)    ReDim t(arrLen) As Integer    If s(0, 0) > 1 Then        s(0, 0) = s(0, 0) - 1        For i = 0 To arrLen            t(i) = s(s(0, 0), i)        Next i    Else        For i = 0 To arrLen            t(i) = -1        Next i    End If    pop = tEnd FunctionFunction push(s() As Integer, val() As Integer)    Dim arrLen As Integer, i As Integer    arrLen = UBound(val)    For i = 0 To arrLen        s(s(0, 0), i) = val(i)    Next i    s(0, 0) = s(0, 0) + 1End Function