Ввод и объявление двумерного массива вручную - VBA

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

Здравствуйте! Прошу помощи. Хочу проверить визуально результат сортировки. Ничего не получается. Ругаю всех преподавателей и ресурсы Интернета. Потратил впустую пять часов.Вопросы: Как ввести и объявить массивом ячейки ниже? Затем проверить: как изменились значения ячеек от быстрой сортировки? Код ниже неработающий! Как исправить?
Sub Sort56()
Dim i%, j%,  A() As Integer
Dim E%, t%, N%, M%
Cells.Clear
N = 6
M = 5
ReDim A(1 To N, 1 To M)
[A1] = -9:  [B1] = -8:  [C1] = -4:  [D1] = -8:  [E1] = -10
[A2] = 0:   [B2] = 3:   [C2] = 0:   [D2] = 6:   [E2] = -9
[A3] = -7:  [B3] = 3:   [C3] = -1:  [D3] = -3:  [E3] = -8
[A4] = 4:   [B4] = 8:   [C4] = 0:   [D4] = -9:  [E4] = 5
[A5] = -2:  [B5] = -1:  [C5] = -1:  [D5] = -6:  [E5] = -4
[A6] = -9   [B6] = 1:   [C6] = -7:   [D6] = 8:   [E6] = -9
 
A(6, 5) = A(i, j)
A(6, 5) = Cells(i, j)
 
E = Cells((i + j) \ 2)
Do
  While Cells(i) < E: i = i + 1: Wend
  While Cells(j) < E: j = j - 1: Wend
  If i <= j Then
  t = Cells(i): Cells(i) = Cells(j): Cells(j) = t
  i = i + 1: j = j - 1
  End If
Loop While i <= j
End Sub

Код к задаче: «Ввод и объявление двумерного массива вручную - VBA»

textual
Sub MySort()
Dim i%, j%, a()
'--------------------
ActiveSheet.UsedRange.EntireRow.Delete
Cells.Clear
[A1] = -9:  [B1] = -8:  [C1] = -4:  [D1] = -8:  [e1] = -10
[A2] = 0:   [B2] = 3:   [C2] = 0:   [D2] = 6:   [E2] = -9
[A3] = -7:  [B3] = 3:   [C3] = -1:  [D3] = -3:  [E3] = -8
[A4] = 4:   [B4] = 8:   [C4] = 0:   [D4] = -9:  [E4] = 5
[A5] = -2:  [B5] = -1:  [C5] = -1:  [D5] = -6:  [E5] = -4
[A6] = -9:  [B6] = 1:   [C6] = -7:  [D6] = 8:   [E6] = -9
a = Sheets(1).[A1].CurrentRegion.Value
    uSort a, 2
    Sheets(1).[g1].Resize(UBound(a, 1), UBound(a, 2)) = a
    Sheets(1).[a8].Resize(UBound(a, 1), UBound(a, 2)) = a
End Sub
  
Private Sub uSort(ByRef x(), N&)
    Dim v, u&, d&, f%, st&
    If IsArray(x) Then
        f = LBound(x): d = f
        For u = f + 1 To UBound(x)
            If x(u, N) < x(d, N) Then
                For st = 1 To UBound(x, 2)
                    v = x(d, st): x(d, st) = x(u, st): x(u, st) = v
                Next
                u = d - 1: d = u - 1: If u < f Then d = u: u = f
            End If
            d = d + 1
        Next
    End If
End Sub

13   голосов, оценка 4.154 из 5


СОХРАНИТЬ ССЫЛКУ