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

Узнай цену своей работы

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

Здравствуйте! Прошу помощи. Хочу проверить визуально результат сортировки. Ничего не получается. Ругаю всех преподавателей и ресурсы Интернета. Потратил впустую пять часов.

Вопросы: Как ввести и объявить массивом ячейки ниже? Затем проверить: как изменились значения ячеек от быстрой сортировки?

Код ниже неработающий! Как исправить?
Листинг программы
  1. Sub Sort56()
  2. Dim i%, j%, A() As Integer
  3. Dim E%, t%, N%, M%
  4. Cells.Clear
  5. N = 6
  6. M = 5
  7. ReDim A(1 To N, 1 To M)
  8. [A1] = -9: [B1] = -8: [C1] = -4: [D1] = -8: [E1] = -10
  9. [A2] = 0: [B2] = 3: [C2] = 0: [D2] = 6: [E2] = -9
  10. [A3] = -7: [B3] = 3: [C3] = -1: [D3] = -3: [E3] = -8
  11. [A4] = 4: [B4] = 8: [C4] = 0: [D4] = -9: [E4] = 5
  12. [A5] = -2: [B5] = -1: [C5] = -1: [D5] = -6: [E5] = -4
  13. [A6] = -9 [B6] = 1: [C6] = -7: [D6] = 8: [E6] = -9
  14. A(6, 5) = A(i, j)
  15. A(6, 5) = Cells(i, j)
  16. E = Cells((i + j) \ 2)
  17. Do
  18. While Cells(i) < E: i = i + 1: Wend
  19. While Cells(j) < E: j = j - 1: Wend
  20. If i <= j Then
  21. t = Cells(i): Cells(i) = Cells(j): Cells(j) = t
  22. i = i + 1: j = j - 1
  23. End If
  24. Loop While i <= j
  25. End Sub

Решение задачи: «Ввод и объявление двумерного массива вручную»

textual
Листинг программы
  1. Sub MySort()
  2. Dim i%, j%, a()
  3. '--------------------
  4. ActiveSheet.UsedRange.EntireRow.Delete
  5. Cells.Clear
  6. [A1] = -9:  [B1] = -8:  [C1] = -4:  [D1] = -8:  [e1] = -10
  7. [A2] = 0:   [B2] = 3:   [C2] = 0:   [D2] = 6:   [E2] = -9
  8. [A3] = -7:  [B3] = 3:   [C3] = -1:  [D3] = -3:  [E3] = -8
  9. [A4] = 4:   [B4] = 8:   [C4] = 0:   [D4] = -9:  [E4] = 5
  10. [A5] = -2:  [B5] = -1:  [C5] = -1:  [D5] = -6:  [E5] = -4
  11. [A6] = -9:  [B6] = 1:   [C6] = -7:  [D6] = 8:   [E6] = -9
  12. a = Sheets(1).[A1].CurrentRegion.Value
  13.     uSort a, 2
  14.     Sheets(1).[g1].Resize(UBound(a, 1), UBound(a, 2)) = a
  15.     Sheets(1).[a8].Resize(UBound(a, 1), UBound(a, 2)) = a
  16. End Sub
  17.  
  18. Private Sub uSort(ByRef x(), N&)
  19.     Dim v, u&, d&, f%, st&
  20.     If IsArray(x) Then
  21.         f = LBound(x): d = f
  22.         For u = f + 1 To UBound(x)
  23.             If x(u, N) < x(d, N) Then
  24.                 For st = 1 To UBound(x, 2)
  25.                     v = x(d, st): x(d, st) = x(u, st): x(u, st) = v
  26.                 Next
  27.                 u = d - 1: d = u - 1: If u < f Then d = u: u = f
  28.             End If
  29.             d = d + 1
  30.         Next
  31.     End If
  32. End Sub

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

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

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут
Похожие ответы