Function GetSquares(ColorID&, Optional ResultArr As Boolean = 1)
    'Находит квадраты залитыми указанным цветом
    Const zs$ = ")", tt$ = ":", zz$ = ","
    Const max& = 2 ^ 31 - 1
    Dim xx&, yy&, X&, Y&, r1 As Range, r2 As Range
    Dim s$, ss$, j$()

    With ActiveSheet
        Set r1 = .Cells(1, 1)
        Application.FindFormat.Clear
        Application.FindFormat.Interior.ColorIndex = ColorID
        Do
            Set r1 = .Cells.Find("", r1, SearchOrder:=xlByRows, SearchFormat:=True)
            If r1 Is Nothing Then Exit Do
            X = r1.Column: Y = r1.Row
            For xx = X To max: If .Cells(Y, xx).Interior.ColorIndex <> ColorID Then Exit For
            Next: xx = xx - 1
            For yy = Y To max: If .Cells(yy, xx).Interior.ColorIndex <> ColorID Then Exit For
            Next: yy = yy - 1: Set r1 = .Cells(Y, xx)
            s = .Cells(Y, X).Address & tt & .Cells(yy, xx).Address
            If InStr(1, ss, s) Then Exit Do
            If InStr(1, ss, .Cells(yy, xx).Address) = 0 Then ss = ss & zz & s
        Loop
        j = Split(Mid$(ss, 2), zz)
        For X = 0 To UBound(j): j(X) = .Range(j(X)).Address: Next
        GetSquares = IIf(ResultArr, j, Join(j, zz))
    End With
End Function