Дан двумерный массив произвольной размерности - VBA

Формулировка задачи:

Попросили сделать, не очень шарю в VBA. Прошу помочь. Дан двумерный массив произвольной размерности. Найти одномерный массив элементы которого равны минимальным значениям в строках исходной матрицы и одномерный массив элементы которого равны максимальным значениям в столбцах исходной матрицы.

Решение задачи: «Дан двумерный массив произвольной размерности»

textual
                            Листинг программы 
                        

                            Sub OneDimARRAYS()
Dim mMax#, mMin#, Strok&, Stolb&, mstr$, A(), hARR(), vARR(), i&, j&
'--Reading--someDATA--from--UserForm-----
      With UserForm1
         mMax = .frmMax.Value:   mMin = .frmMin.Value
         Strok = .frmStrok.Value: Stolb = .frmStolb
      End With
'==End==Reading=======================
   ReDim A(1 To Strok, 1 To Stolb)
   ReDim hARR(1 To Strok, 1 To 1): ReDim vARR(1 To Stolb, 1 To 1)
'--Create--DataARRAY-------------------------
   For i = 1 To Strok
      For j = 1 To Stolb
         A(i, j) = Int(Rnd() * (mMax - mMin)) + mMin
      Next j
   Next i
'==End==Create===========================
'--Separate--Min--Max-----------------------
   ' & add to arrays...
   For i = 1 To 2
      If i = 2 Then A = Application.Transpose(A)
         For j = LBound(A, 1) To UBound(A, 1)
            If i = 1 Then
               mstr = mstr & Join(Application.Index(A, j, 0), ";" & Space(1)) & Chr(10)
               hARR(j, 1) = Application.Min(Application.Index(A, j, 0))
                  Else: vARR(j, 1) = Application.Max(Application.Index(A, j, 0))
            End If
         Next  'j
   Next ' i
'==End==Separate==========================
   Application.ScreenUpdating = False
   A = Application.Transpose(A):  ActiveSheet.Cells.Delete
   UserForm1.MAS.Caption = mstr 'array to UserForm
 '--Results--On--Sheet-----------------
   [a1].Value = "Array MINIMUM": [d1].Value = "Array  MAXIMUM"
   [a2].Resize(UBound(hARR, 1), 1).Value = hARR
   [d2].Resize(UBound(vARR, 1), 1).Value = vARR
'==end==with==Resutls==&==with==Sheets===========
'--EndAll-------------------------------------
   Application.ScreenUpdating = True
   MsgBox Space(10) & "D O N E!"
 '==End================================
End Sub
                        