Option Explicit

Private Sub LosowoKoloruj(zakres As Range)
'procedura do losowego generowania macierzy
Dim komorka As Object

Dim losowa As Double

Randomize

For Each komorka In zakres
    losowa = Rnd
    If losowa < 0.5 Then
        komorka.Interior.Color = RGB(0, 0, 0)
    Else
        komorka.Interior.Color = RGB(255, 255, 255)
    End If
Next komorka

End Sub

Private Function WykryjWyspe(arrWyspa, arrWejsciowa, i_koniec, j_koniec) As Boolean

Dim i, j As Integer
Dim zmienione As Boolean

WykryjWyspe = False

Do
zmienione = False

For i = 1 To (UBound(arrWyspa, 1) - 1)
    For j = 1 To (UBound(arrWyspa, 2) - 1)
                 
        If (arrWyspa(i, j)) Then
        
            If i = i_koniec And j = j_koniec Then
                WykryjWyspe = True
                Exit Do
            End If
            
            'poprzedni wiersz
            If (arrWejsciowa(i - 1, j) And Not (arrWyspa(i - 1, j))) Then
                arrWyspa(i - 1, j) = True
                zmienione = True
            End If
            'następny wiersz
            If (arrWejsciowa(i + 1, j) And Not (arrWyspa(i + 1, j))) Then
                arrWyspa(i + 1, j) = True
                zmienione = True
            End If
            'poprzednia kolumna
            If (arrWejsciowa(i, j - 1) And Not (arrWyspa(i, j - 1))) Then
                arrWyspa(i, j - 1) = True
                zmienione = True
            End If
            'następna kolumna
            If (arrWejsciowa(i, j + 1) And Not (arrWyspa(i, j + 1))) Then
                arrWyspa(i, j + 1) = True
                zmienione = True
            End If
            
         End If
    Next j
Next i

Loop While (zmienione)

'PĘTLA TESTOWA - kolorowanie wyspy zawierającej komórkę starową
'na Arkuszu maluje wyspę z tablicy
For i = 1 To (UBound(arrWyspa, 1))
    For j = 1 To (UBound(arrWyspa, 2))
        If arrWyspa(i, j) Then
            Cells(i, j).Interior.Color = RGB(0, 0, 255)
        End If
    Next j
Next i

End Function

Public Sub zakres()

Dim zakres As Range
Dim strZakres, strKomorkaStart, strKomorkaKon As String
Dim i_Start, j_Start As Integer
Dim i_koniec, j_koniec As Integer
Dim komorka As Object
Dim wartosc As Boolean
Dim strCzyKolorowac As String
Dim i, j As Integer
Dim arrWejsciowa() As Boolean, arrWyspa() As Boolean
Dim czyJestDroga As Boolean

'pobranie od użytkownika zakresu.
'W obecnej formie wskazany zakres musi się zaczynać na komórce A1

strZakres = Application.InputBox("Wskaż zakres macierzy A :", , , , , , , 8).Address()

Set zakres = Range(strZakres)

strCzyKolorowac = MsgBox("Czy chcesz losowo wygenerować tablicę ?", vbYesNo)

If strCzyKolorowac = vbYes Then
    Call LosowoKoloruj(zakres)
End If

'pobranie od uzytkownika komorek
strKomorkaStart = Application.InputBox("Wskaż pierwszą komrókę :", , , , , , , 8).Address()
strKomorkaKon = Application.InputBox("Wskaż drugą komrókę :", , , , , , , 8).Address()

If Range(strKomorkaStart).Interior.Color <> Range(strKomorkaKon).Interior.Color Then
    MsgBox "Wskazałeś komórki o różnych kolorach"
    Exit Sub
End If
'indeksy komórki startu
i_Start = Range(strKomorkaStart).Row
j_Start = Range(strKomorkaStart).Column
'indeksy komórki końcowej
i_koniec = Range(strKomorkaKon).Row
j_koniec = Range(strKomorkaKon).Column

'ustalenie wymiaru tablic
' + 1 przy indeksowaniu tablic od 0 dwa dwie kolumny "marginesu"
ReDim arrWejsciowa((zakres.Rows.Count + 1), (zakres.Columns.Count + 1))
ReDim arrWyspa((zakres.Rows.Count + 1), (zakres.Columns.Count + 1))

'wypełnienie tablic wartościami startowymi
For i = 0 To UBound(arrWejsciowa, 1)
    For j = 0 To UBound(arrWejsciowa, 2)
        arrWejsciowa(i, j) = False
        arrWyspa(i, j) = False
    Next j
Next i

'ustawienie wartości w tablicy wejściowej
'nie ma znacznia ile i jakich kolorów jest na arkuszu
'zgodność kolorów startu i końca jest sprawdzana wcześniej
For Each komorka In zakres
    If komorka.Interior.Color = Range(strKomorkaStart).Interior.Color Then
        arrWejsciowa((komorka.Row), (komorka.Column)) = True
    End If
Next komorka

arrWyspa(i_Start, j_Start) = True 'ustawienie wartości poczatkowej w tablicy

czyJestDroga = WykryjWyspe(arrWyspa, arrWejsciowa, i_koniec, j_koniec)

If czyJestDroga Then
    MsgBox "Droga istnieje"
Else
    MsgBox "Droga nie istnieje"
End If

Set zakres = Nothing

End Sub