Добавить (удалить) 1 элемент с конца массива

Option Explicit
'функция добавления 1 элемента в конец массива
Function PushBack(Arr() As Double, x, b) As Double()
ReDim Preserve Arr(x) 'Выделим память
Arr(x) = b 'Добавил 1 элемент
x = x + 1 'Добавил память
PushBack = Arr
End Function
 
'функция удаления 1 элемента с конца массива
Function PopBack(Arr() As Double) As Double()
Dim x As Integer, i As Integer, Temp() As Double
x = UBound(Arr) 'измерил массив
If x >= 1 Then ReDim Temp(x - 1) _
Else: PopBack = Arr: Exit Function   'переопределил память если выходим за нижний предел
                                     'выходим из функции продолжать нет смысла
 
For i = 0 To UBound(Temp)
Temp(i) = Arr(i) 'копирую поэлементно во временный массив
Next
 
Erase Arr() 'удаляю массив
Arr = Temp  'копирую из временного массива
Erase Temp() 'удаляю временный массив
PopBack = Arr
End Function
 
'процедура печати массива
Sub PrintMas(Arr() As Double)
Dim j As Byte
For j = LBound(Arr) To UBound(Arr)
Print Arr(j);
Next
Print
End Sub
 
'Test
Private Sub Command1_Click()
 
Dim Test() As Double, Test1() As Double
Dim i As Integer, j As Integer, N As Integer
 
Print "Добавляю в цикле"
For i = -5 To 5
Test = PushBack(Test(), N, i) 'Добавляю в цикле
Next
PrintMas Test()
 
Print "Добавляю 1 элемент"
Test = PushBack(Test(), N, 100) 'Добавляю 1 элемент
PrintMas Test()
 
Print "удаляю 1 элемент"
Test = PopBack(Test()) 'удаляю 1 элемент
PrintMas Test()
 
Print "удаляю в цикле"
For i = 1 To 6
Test = PopBack(Test()) 'удаляю в цикле
Next
PrintMas Test()
 
Print "удаляю в цикле явно больше массива,0вой остался "
For i = 1 To 10
Test = PopBack(Test()) 'удаляю в цикле явно больше массива
Next
PrintMas Test() 'прокол, 0вой остался
End Sub

Option Explicit
 
'ПОДПРОГРАММА добавления 1 элемента в конец массива
Sub PushBack(Arr() As Double, b)
  On Error GoTo 1   'переход в случае ошибки
  ReDim Preserve Arr(UBound(Arr) + 1) 'Выделим память
  Arr(UBound(Arr)) = b 'Заполнил 1 элемент
  Exit Sub
 
1 ReDim Arr(0)      'ошибка возникает, если массив не инициализирован.
  Arr(0) = b        'инициализируем и заполняем
End Sub
 
'функция удаления 1 элемента с конца массива
Function PopBack(Arr() As Double) ' As Double
Dim x As Long, i As Integer, Temp() As Double
On Error GoTo 1
x = UBound(Arr) 'измерил массив
PopBack = Arr(x)
If x > 0 Then
  ReDim Preserve Arr(x - 1)
Else
  Erase Arr
End If
Exit Function
 
1 PopBack = "нечего возвращать!"
End Function
 
'процедура печати массива
Sub PrintMas(Arr() As Double)
Dim j As Long
On Error GoTo 1
For j = LBound(Arr) To UBound(Arr)
Print Arr(j);
Next
Print
Exit Sub
 
1 Print "массив пуст!"
End Sub
 
'Test
Private Sub Command1_Click()
 
Dim Test() As Double, Test1
Dim i As Integer, j As Integer, N As Integer
 
Print "Добавляю в цикле"
For i = -5 To 5
PushBack Test(), i 'Добавляю в цикле
Next
PrintMas Test()
 
Print "Добавляю 1 элемент"
PushBack Test(), 100  'Добавляю 1 элемент
PrintMas Test()
 
Print "удаляю 1 элемент"
Test1 = PopBack(Test()) 'удаляю 1 элемент
Print Test1
PrintMas Test()
 
Print "удаляю в цикле"
For i = 1 To 15
Print PopBack(Test())  'удаляю в цикле
PrintMas Test()
Next
End Sub

Option Explicit
 
Private Sub Push(Arr() As Double, ByVal v As Double)
    On Error Resume Next
    If (Not Arr) = -1 Then ReDim Arr(0) Else ReDim Preserve Arr(UBound(Arr) + 1)
    Arr(UBound(Arr)) = v
End Sub
 
Private Function Pop(Arr() As Double) As Double
    On Error Resume Next
    If (Not Arr) = -1 Then Exit Function
    Pop = Arr(UBound(Arr))
    If UBound(Arr) = 0 Then Erase Arr Else ReDim Preserve Arr(UBound(Arr) - 1)
End Function
 
Private Sub Form_Load()
    Dim ar() As Double
    
    Push ar(), 10
    Push ar(), 9
    Push ar(), 8
    Push ar(), 7
    
    Debug.Print Pop(ar)
    
    Push ar(), 21
    Push ar(), 22
    
    Debug.Print Pop(ar)
    Debug.Print Pop(ar)
    Debug.Print Pop(ar)
    Debug.Print Pop(ar)
    Debug.Print Pop(ar)
    
    Debug.Print Pop(ar)
    
End Sub