Sub MAIN()
Set T = Sheets("массив точек").Cells
Set M = Sheets("многоугольники").Cells
For R = 2 To T(T.Rows.Count, 1).End(xlUp).Row
  X = T(R, 2): Y = T(R, 3)
  For RR = 2 To M(M.Rows.Count, 1).End(xlUp).Row
    XY = Range(M(RR, 2), M(RR, M(RR, M.Columns.Count).End(xlToLeft).Column))
    SS = 0
    For I = 1 To UBound(XY, 2) Step 2
      S = Sgn((XY(1, I) - X) * (XY(1, (I + 2) Mod UBound(XY, 2) + 1) - Y) - (XY(1, (I + 1) Mod UBound(XY, 2) + 1) - X) * (XY(1, I + 1) - Y))
      If S Then If SS Then If S <> SS Then Exit For
      If S Then SS = S
    Next I
    If I > UBound(XY, 2) Then T(R, 4) = RR - 1: Exit For
  Next RR
Next R
End Sub

Const k2 = 2 / 3
Function diplom2(ByVal px As Double, ByVal py As Double) As Integer
Dim r As Integer
Dim stroka, stolbec, areaNumber As Integer
Dim КоличествоПересечений As Byte
Dim xx0, yy0 As Double
Dim Msg As String

x0 = px
y0 = py
stolbec = -1
stroka = 2
areaNumber = 0

DoAgain:
If areaNumber > 46 Then GoTo EndPoint2
КоличествоПересечений = 0
areaNumber = areaNumber + 1
stolbec = stolbec + 3
stroka = 2
'MsgBox ("stolbec=" & stolbec & " stroka=" & stroka & " areaNumber=" & areaNumber)
Do
'If stroka = 6 Then Exit Do
If Worksheets("areas").Cells(stroka + 1, stolbec) = "" Then Exit Do
If Пересекает(Worksheets("areas").Cells(stroka, stolbec), _
Worksheets("areas").Cells(stroka, stolbec + 1), _
Worksheets("areas").Cells(stroka + 1, stolbec), _
Worksheets("areas").Cells(stroka + 1, stolbec + 1), _
px, py) Then
КоличествоПересечений = КоличествоПересечений + 1
End If
stroka = stroka + 1
Loop
If КоличествоПересечений Mod 2 <> 0 Then GoTo EndPoint1
If КоличествоПересечений Mod 2 = 0 Then GoTo DoAgain

EndPoint1:
diplom2 = areaNumber
EndPoint2:
End Function

Private Function Пересекает(x1 As Double, y1 As Double, _
x2 As Double, y2 As Double, _
x0 As Double, y0 As Double) As Boolean
Dim x_min As Double, x_max As Double
Dim k1 As Double, b1 As Double, b2 As Double, x_ As Double

Пересекает = False

'If x1 = x2 Then x2 = x1 + 0.001 'для вертикальных отрезков!

If x1 > x2 Then
x_max = x1
x_min = x2
Else
x_max = x2
x_min = x1
End If

k1 = (y2 - y1) / (x2 - x1)
b1 = y1 - k1 * x1

b2 = y0 - k2 * x0

x_ = -(b2 - b1) / (k2 - k1)

If (x_ > x_min And x_ <= x_max) And (x_ > x0) Then Пересекает = True 'And (x_ > x0) при k=1
End Function