Сортировка и вывод данных - VB

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

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

Имеется такая задача: Дана матрица натуральных чисел Y(n,m), в которой столбцы упорядочены по убыванию. Переместить содержимое матрицы в массив S(k) по столбцам и упорядочить по убыванию, удалив одинаковые элементы. Определить новое количество элементов. Я набросал код к ней:
Листинг программы
  1. Option Base 1
  2. Sub ShellSort(vArray As Variant)
  3. Dim TempVal As Variant
  4. Dim i As Long, GapSize As Long, CurPos As Long
  5. Dim FirstRow As Long, LastRow As Long, NumRows As Long
  6. FirstRow = LBound(vArray)
  7. LastRow = UBound(vArray)
  8. NumRows = LastRow - FirstRow + 1
  9. Do
  10. GapSize = GapSize * 3 + 1
  11. Loop Until GapSize > NumRows
  12. Do
  13. GapSize = GapSize \ 3
  14. For i = (GapSize + FirstRow) To LastRow
  15. CurPos = i
  16. TempVal = vArray(i)
  17. Do While CompareResult(vArray(CurPos - GapSize), TempVal)
  18. vArray(CurPos) = vArray(CurPos - GapSize)
  19. CurPos = CurPos - GapSize
  20. If (CurPos - GapSize) < FirstRow Then Exit Do
  21. Loop
  22. vArray(CurPos) = TempVal
  23. Next
  24. Loop Until GapSize = 1
  25. End Sub
  26. Private Function CompareResult(Value1 As Variant, Value2 As Variant)
  27. CompareResult = (Value1 > Value2)
  28. End Function
  29. Function DelArr(ByRef nArr() As Long, ByVal nIndex As Long)
  30. If UBound(nArr) = nIndex Then
  31. ReDim Preserve nArr(nIndex - 1)
  32. Else
  33. 'Смещаем все элементы
  34. For i = nIndex To UBound(nArr) - 1
  35. nArr(i) = nArr(i + 1)
  36. Next i
  37. 'Подтираем последний
  38. ReDim Preserve nArr(UBound(nArr) - 1)
  39. End If
  40. End Function
  41. Private Sub Command1_Click()
  42. Dim tmp As Long
  43. Dim Y() As Long
  44. Dim S() As Long
  45. Dim i, j, n, M As Long
  46. Dim st As String
  47. n = CLng(Text1)
  48. M = CLng(Text2)
  49. ReDim Y(n, M) As Long
  50. k = M * n
  51. For i = 1 To n
  52. For j = 1 To M
  53. Y(i, j) = CLng(InputBox("Строка" & Str(i) & ", столбец" & Str(j), "Ввод массива"))
  54. Next j
  55. Next i
  56. ReDim S(k) As Long
  57. For j = 1 To n
  58. For i = 1 To M
  59. S(k) = Y(j, i)
  60. Text3 = Text3 + CStr(S(k)) + " "
  61. Next i
  62. Next j
  63. ShellSort (S)
  64. i = 2
  65. Do While i <> UBound(S)
  66. For j = 1 To i - 1
  67. If S(i) = S(j) Then
  68. Call DelArr(S, i)
  69. i = i - 1
  70. Exit For
  71. End If
  72. Next
  73. i = i + 1
  74. Loop
  75. Text3 = Text3 + "Начинается: "
  76. For i = 1 To UBound(S)
  77. Text3 = Text3 + CStr(S(i)) + " "
  78. Next i
  79. End Sub
Все вроде ничего, но вывод после сортирвки не идет. В чем проблема? Заранее благодарю

Решение задачи: «Сортировка и вывод данных»

textual
Листинг программы
  1. Private Sub Command1_Click()
  2. Text3 = "Полученный массив: "
  3. Text4 = "Обработанный массив: "
  4. n = Text1
  5. m = Text2
  6. cnt = n * m
  7. ReDim mas(n, m) As Integer
  8. ReDim S(cnt) As Integer
  9.  
  10. 'заполнение массива случайными числами
  11. For i = 0 To n - 1
  12.     For j = 0 To m - 1
  13.         mas(i, j) = Rnd(1) * 10
  14.     Next
  15. Next
  16.  
  17. 'Перемещение содержимого матрицы в массив S
  18. k = 0
  19. For i = 0 To n - 1
  20.     For j = 0 To m - 1
  21.         S(k) = mas(i, j)
  22.         Text3 = Text3 & " " & S(k)
  23.         k = k + 1
  24.     Next
  25. Next
  26.  
  27. 'Сортировка массива S
  28. For i = 1 To cnt - 1
  29.     j = i
  30.     Do While j > 0
  31.         If S(j) > S(j - 1) Then
  32.             t = S(j)
  33.             S(j) = S(j - 1)
  34.             S(j - 1) = t
  35.             j = j - 1
  36.         Else
  37.             Exit Do
  38.         End If
  39.     Loop
  40. Next
  41.  
  42. 'Удаление повторяющихся значений
  43. i = 0
  44. Do While i < cnt
  45.     If S(i) = S(i + 1) Then
  46.         j = i + 1
  47.         cnt = cnt - 1
  48.         Do While j < cnt
  49.            
  50.             S(j) = S(j + 1)
  51.             j = j + 1
  52.         Loop
  53.     Else
  54.         i = i + 1
  55.     End If
  56. Loop
  57.  
  58. 'Вывод результата
  59. k = 0
  60. For i = 0 To cnt - 1
  61.         Text4 = Text4 & " " & S(i)
  62. Next
  63. Text4 = Text4 & ", количество элементов " & cnt
  64. End Sub

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


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

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

9   голосов , оценка 4.333 из 5

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

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

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