Перемещение фишки в поиске другой фишки - VBA - Ответ 2340479

Sub Fishka8ver2()
 
Dim base() As Variant
Dim col As Range
Dim xt As Integer, yt As Integer
Set rng = Range("A1:H8")
'ActiveSheet.UsedRange.Cells.Interior.ColorIndex = 0
 
With Application.WorksheetFunction
    If .CountIf(rng, 0) <> 1 Or .CountIf(rng, -2) <> 1 Then
        Cells(10, 1) = "Демонстрация"
        Cells(1, 1) = 0: Cells(1, 3) = -1
        Cells(2, 3) = -1: Cells(2, 4) = -1
        Cells(4, 4) = -1: Cells(5, 3) = -1
        Cells(8, 8) = -2: rng.HorizontalAlignment = xlCenter
        MsgBox "Фишка № 1 обозначается нулем '0'" & vbCr & "Фишка назначения № 2 обозначается '-2'" & vbCr & "Препятствия '-1'."
        Else: Cells(10, 1).Clear
    End If
End With
 
base = Application.Transpose(rng)
 
For Each col In rng
    If col.Value = 0 And CStr(col.Value) <> "" Then posX = col.Column: posY = col.Row
Next
 
a = 0 'Движение c клетки "0"
x = posX: y = posY
Do While a <> 20
    For y = 1 To 8
        For x = 1 To 8
            If base(x, y) = a And CStr(base(x, y)) <> "" Then
                For direct = 1 To 8
                    route x:=x, y:=y, xt:=xt, yt:=yt, direct:=direct
                    If xt >= 1 And xt <= 8 And yt >= 1 And yt <= 8 Then
                        If base(xt, yt) = -2 Then
                            MsgBox a + 1 & " шагов."
                            Exit Sub
                        End If
                        If (CStr(base(xt, yt)) = "" Or base(xt, yt) > a) And CStr(base(xt, yt)) <> "0" Then
                                base(xt, yt) = a + 1
                                Cells(yt, xt) = a + 1 'удалить?
                        End If
                    End If
                Next direct
            End If
        Next x
    Next y
    a = a + 1
Loop
MsgBox "Нет решения!"
End Sub
 
Private Sub route(ByVal x As Integer, ByVal y As Integer, ByRef xt As Integer, ByRef yt As Integer, ByVal direct As Integer)
Select Case direct 'направление хода конем
    Case 1
        xt = x + 1: yt = y - 2 'вверх2-направо
    Case 2
        xt = x + 2: yt = y - 1 'вверх-направо2
    Case 3
        xt = x + 2: yt = y + 1 'вниз-направо2
    Case 4
        xt = x + 1: yt = y + 2 'вниз2-направо
    Case 5
        xt = x - 1: yt = y + 2 'вниз2-налево
    Case 6
        xt = x - 2: yt = y + 1 'вниз-налево2
    Case 7
        xt = x - 2: yt = y - 1 'вверх-налево2
    Case 8
        xt = x - 1: yt = y - 2 'вверх2-налево
End Select
End Sub