Option Explicit
Private Type t_Coor
  X As Double
  Y As Double
End Type

Private Type t_XLine
  A As t_Coor
  B As t_Coor
  A2B As Double
  v As Boolean
End Type

Function PinAB(P As t_Coor, L As t_XLine) As Boolean
PinAB = (P.X - L.A.X) * (L.B.X - P.X) > 0 Or (P.Y - L.A.Y) * (L.B.Y - P.Y) > 0
End Function

Sub main()
Dim L() As t_XLine
Dim aP() As t_Coor
Dim CP As Long
Dim UL As Long
Dim UC As Long, US As Long
Dim P As t_Coor
Dim rn As Range, i As Long, j As Long, ws As Worksheet
Set ws = ActiveSheet
Dim sh, ash() 'As Shapes
For Each sh In ws.Shapes
  sh.Delete
Next sh

For Each rn In ws.UsedRange
  If rn = 1 Then
    ReDim Preserve aP(CP)
    aP(CP).X = rn.Column
    aP(CP).Y = rn.Row
    For i = 0 To CP - 1
      ReDim Preserve L(UL), ash(UL)
      With L(UL)
        .A = aP(i)
        .B = aP(CP)
        .A2B = A2B(.A, .B)
        .v = True
''''''''''''''''''''''''''''''''''''''
        If (rn.Left = Cells(.A.Y, .A.X).Left) Or (rn.Top = Cells(.A.Y, .A.X).Top) Then
            Set ash(UL) = ws.Shapes.AddLine(rn.Left, rn.Top, Cells(.A.Y, .A.X).Left, Cells(.A.Y, .A.X).Top) '.Select
            ash(UL).Select
        End If
'''''''''''''''''''''''''''''''''''''
      End With

      UL = UL + 1
    Next i
    CP = CP + 1
  End If
Next rn
End Sub

'расстояние от точки до точки
Private Function A2B(A As t_Coor, B As t_Coor) As Double
A2B = Sqr((A.X - B.X) * (A.X - B.X) + (A.Y - B.Y) * (A.Y - B.Y))
End Function