Public Sub sRobot()
Const p As Integer = 1
Dim sArr(), maxA As Long, i As Long, r As Long, s1, s2, t As Long, stp As Long
sArr = Sheet1.Range("A2:C17").Value
maxA = UBound(sArr, 1)
ReDim dArr(1 To 1000000, 1 To 3)
For i = 1 To maxA - 1
If i < r Then GoTo 1
s1 = sArr(i, 1)
If s1 <> Empty Then
For r = i + 1 To maxA
s2 = sArr(r, 1)
If s2 <> Empty Then
If s1 <= s2 Then stp = p Else stp = -p
If r < maxA Then
For s = s1 To s2 - stp Step stp
If t > 1000000 Then GoTo 2
t = t + 1
dArr(t, 1) = s
If s = s1 Then
dArr(t, 2) = sArr(i, 2)
dArr(t, 3) = sArr(i, 3)
End If
Next s
Else
For s = s1 To s2 Step stp
If t > 1000000 Then GoTo 2
t = t + 1
dArr(t, 1) = s
If s = s1 Then
dArr(t, 2) = sArr(i, 2)
dArr(t, 3) = sArr(i, 3)
End If
If s = s2 Then
dArr(t, 2) = sArr(r, 2)
dArr(t, 3) = sArr(r, 3)
End If
Next s
End If
Exit For
End If
Next r
End If
1:
Next i
2:
If t Then Sheet1.Range("E2").Resize(t, 3) = dArr
End Sub