Как исключить из одномерного массива max и min?

redim preserve R(k)

FOR i = 1 TO k

Sub Fill_Arr(A() As Integer)
    n% = UBound(A, 1)
    Randomize
    For i% = 1 To n%
        A(i%) = 10 * Rnd
    Next i%
End Sub
 
Sub Del_max_min(A() As Integer, n As Integer)
    n = UBound(A, 1)
    mi% = A(1)
    ma% = A(1)
    For i% = 2 To n%
        If A(i%) < mi% Then mi% = A(i%)
        If A(i%) > ma% Then ma% = A(i%)
    Next i%
    i% = 1
    Do
      If A(i%) = mi% Or A(i%) = ma% Then del_el A(), n, i%
      i% = i% + 1
      If i% > n Then Exit Do
    Loop
End Sub
 
Sub del_el(A() As Integer, n As Integer, k As Integer)
    If n = k Then
       n = n - 1
       Exit Sub
    Else
       For i% = k To n - 1
           A(i%) = A(i% + 1)
       Next i%
       n = n - 1
    End If
End Sub
 
Sub Test()
Dim A(1 To 20) As Integer
    n% = 20
    Fill_Arr A()
    Debug.Print "Исходный массив:"
    For i% = 1 To 20
        Debug.Print "A("; i%; ")="; A(i%)
    Next i%
    Del_max_min A(), n%
    Debug.Print "После удаления:"
    For i% = 1 To n%
        Debug.Print "A("; i%; ")="; A(i%)
    Next i%
End Sub

Sub Fill_Arr(A() As Integer)
n% = UBound(A, 1)
    'Randomize
    For i% = 1 To n%
        A(i%) = 10
    Next i%

Sub Del_max_min(A() As Integer, n As Integer)
    n = UBound(A, 1)
    mi% = A(1)
    ma% = A(1)
    For i% = 2 To n%
        If A(i%) < mi% Then mi% = A(i%)
        If A(i%) > ma% Then ma% = A(i%)
    Next i%
    i% = 1
    Do
      If A(i%) = mi% Or A(i%) = ma% Then
         del_el A(), n, i%
         i% = i% - 1
      End If
      i% = i% + 1
      If i% > n Then Exit Do
    Loop
End Sub

Function max_min(A(), pr%)
Dim i%
    max_min = A(1)
    For i = 2 To UBound(A)
        If max_min * pr < A(i) * pr Then max_min = A(i)
    Next i
End Function
 
Sub del_el(A(), b)
Dim i%, j%, k%
 
       For i = 1 To UBound(A)
          Do While A(i) = b
             k = k + 1
              If UBound(A) - k < i Then
                 Exit For
              End If
               For j = i To UBound(A) - k
                  A(j) = A(j + 1)
               Next j
          Loop
       Next i
 ReDim Preserve A(UBound(A) - k)
End Sub
 
 
 
Private Sub Command1_Click()
Dim i%, n%
    Cls
    n = 3
    ReDim A(n)
    Randomize (Timer)
    For i = 1 To n
        A(i) = Int(Rnd * 10) - 5
        'A(i) = 10
        Print A(i); vbTab;
    Next i
    Print: Print
    Max = max_min(A(), 1)
    Min = max_min(A(), -1)
    Print "Max="; Max; vbTab; "Min="; Min
       Call del_el(A(), Min)
       Call del_el(A(), Max)
          If UBound(A) = 0 Then
             MsgBox "Null": Exit Sub
          Else
             Print: Print
             For i = 1 To UBound(A)
                 Print A(i); vbTab;
             Next i
          End If
End Sub

Option Explicit
Declare Function SafeArrayGetDim Lib "oleaut32.dll" (ByRef saArray() As Any) As Long
 
Private Sub Fill_Array(ByRef A() As Long, ByVal Bound As Long, _
    ByVal nFrom As Long, ByVal nTo As Long, _
    ByRef min As Long, ByRef max As Long)
    'Bound 'кол-во эл-тов
    'nFrom 'диапазон - от
    'nTo 'диапазон - до (включительно)
    'min 'буфер для получения мин. числа
    'max 'буфер для получения макс. числа
    Dim n As Long
    ReDim A(Bound)
    min = nFrom: max = nTo
    
    For n = 0 To Bound
        A(n) = Int(Rnd * (nTo - nFrom + 1)) + nFrom
        If A(n) > max Then max = A(n)
        If A(n) < min Then min = A(n)
    Next
End Sub
 
Private Function Del_min_max(ByRef A() As Long, ByVal min As Long, ByVal max As Long)
    Dim B() As Long
    Dim n As Long
    Dim c As Long
    ReDim B(UBound(A))
    
    For n = 0 To UBound(A)
        If A(n) <> max And A(n) <> min Then
            B(c) = A(n)
            c = c + 1
        End If
    Next
    
    If c = 0 Then Erase B() Else ReDim Preserve B(c - 1)
    Del_min_max = B()
End Function
 
Public Sub main()
    Dim A() As Long
    Dim min As Long 'буфер для получения мин. числа
    Dim max As Long 'буфер для получения макс. числа
    Dim n As Long
    
    Call Fill_Array(A(), 20, 0, 9, min, max)
    
    Debug.Print "Исходный массив:"
    For n = 0 To UBound(A)
        Debug.Print "A("; n; ")="; A(n)
    Next
    
    A() = Del_min_max(A(), min, max)
    
    Debug.Print "После удаления:"
    If SafeArrayGetDim(A) <> 0 Then
        For n = 0 To UBound(A)
            Debug.Print "A("; n; ")="; A(n)
        Next
    End If
End Sub

    min = nTo: max = nFrom
    Randomize

Function max_min(a(), pr%)
Dim i%
    If UBound(a) > 0 Then
    max_min = a(1)
    For i = 2 To UBound(a)
        If max_min * pr < a(i) * pr Then max_min = a(i)
    Next i
    End If
End Function
 
Sub del_el(a(), b)
Dim i%, j%, k%
       For i = 1 To UBound(a)
          Do While a(i) = b
             k = k + 1
              If UBound(a) - k < i Then Exit For
               For j = i To UBound(a) - k
                  a(j) = a(j + 1)
               Next j
          Loop
       Next i
 ReDim Preserve a(UBound(a) - k)
End Sub
Sub prt(a(), g As Boolean)
Print IIf(g, "Inp", "Result")
For i = 1 To UBound(a)
If g Then a(i) = Int(Rnd * 10) - 5  'A(i) = 10
        Print a(i); vbTab;
Next i
    Print: Print
End Sub
 
 
Private Sub Command1_Click()
Dim i%, n%
    Me.Cls: n = 3: Randomize (Timer)
    ReDim a(n)
Call prt(a, True)
    Call del_el(a(), max_min(a(), -1))
    Call del_el(a(), max_min(a(), 1))
Call prt(a, False)
End Sub