Сортировка и вывод данных - VB
Формулировка задачи:
Имеется такая задача:
Дана матрица натуральных чисел Y(n,m), в которой столбцы упорядочены по убыванию. Переместить содержимое матрицы в массив S(k) по столбцам и упорядочить по убыванию, удалив одинаковые элементы. Определить новое количество элементов.
Я набросал код к ней:
Все вроде ничего, но вывод после сортирвки не идет.
В чем проблема?
Заранее благодарю
Листинг программы
- Option Base 1
- Sub ShellSort(vArray As Variant)
- Dim TempVal As Variant
- Dim i As Long, GapSize As Long, CurPos As Long
- Dim FirstRow As Long, LastRow As Long, NumRows As Long
- FirstRow = LBound(vArray)
- LastRow = UBound(vArray)
- NumRows = LastRow - FirstRow + 1
- Do
- GapSize = GapSize * 3 + 1
- Loop Until GapSize > NumRows
- Do
- GapSize = GapSize \ 3
- For i = (GapSize + FirstRow) To LastRow
- CurPos = i
- TempVal = vArray(i)
- Do While CompareResult(vArray(CurPos - GapSize), TempVal)
- vArray(CurPos) = vArray(CurPos - GapSize)
- CurPos = CurPos - GapSize
- If (CurPos - GapSize) < FirstRow Then Exit Do
- Loop
- vArray(CurPos) = TempVal
- Next
- Loop Until GapSize = 1
- End Sub
- Private Function CompareResult(Value1 As Variant, Value2 As Variant)
- CompareResult = (Value1 > Value2)
- End Function
- Function DelArr(ByRef nArr() As Long, ByVal nIndex As Long)
- If UBound(nArr) = nIndex Then
- ReDim Preserve nArr(nIndex - 1)
- Else
- 'Смещаем все элементы
- For i = nIndex To UBound(nArr) - 1
- nArr(i) = nArr(i + 1)
- Next i
- 'Подтираем последний
- ReDim Preserve nArr(UBound(nArr) - 1)
- End If
- End Function
- Private Sub Command1_Click()
- Dim tmp As Long
- Dim Y() As Long
- Dim S() As Long
- Dim i, j, n, M As Long
- Dim st As String
- n = CLng(Text1)
- M = CLng(Text2)
- ReDim Y(n, M) As Long
- k = M * n
- For i = 1 To n
- For j = 1 To M
- Y(i, j) = CLng(InputBox("Строка" & Str(i) & ", столбец" & Str(j), "Ввод массива"))
- Next j
- Next i
- ReDim S(k) As Long
- For j = 1 To n
- For i = 1 To M
- S(k) = Y(j, i)
- Text3 = Text3 + CStr(S(k)) + " "
- Next i
- Next j
- ShellSort (S)
- i = 2
- Do While i <> UBound(S)
- For j = 1 To i - 1
- If S(i) = S(j) Then
- Call DelArr(S, i)
- i = i - 1
- Exit For
- End If
- Next
- i = i + 1
- Loop
- Text3 = Text3 + "Начинается: "
- For i = 1 To UBound(S)
- Text3 = Text3 + CStr(S(i)) + " "
- Next i
- End Sub
Решение задачи: «Сортировка и вывод данных»
textual
Листинг программы
- Private Sub Command1_Click()
- Text3 = "Полученный массив: "
- Text4 = "Обработанный массив: "
- n = Text1
- m = Text2
- cnt = n * m
- ReDim mas(n, m) As Integer
- ReDim S(cnt) As Integer
- 'заполнение массива случайными числами
- For i = 0 To n - 1
- For j = 0 To m - 1
- mas(i, j) = Rnd(1) * 10
- Next
- Next
- 'Перемещение содержимого матрицы в массив S
- k = 0
- For i = 0 To n - 1
- For j = 0 To m - 1
- S(k) = mas(i, j)
- Text3 = Text3 & " " & S(k)
- k = k + 1
- Next
- Next
- 'Сортировка массива S
- For i = 1 To cnt - 1
- j = i
- Do While j > 0
- If S(j) > S(j - 1) Then
- t = S(j)
- S(j) = S(j - 1)
- S(j - 1) = t
- j = j - 1
- Else
- Exit Do
- End If
- Loop
- Next
- 'Удаление повторяющихся значений
- i = 0
- Do While i < cnt
- If S(i) = S(i + 1) Then
- j = i + 1
- cnt = cnt - 1
- Do While j < cnt
- S(j) = S(j + 1)
- j = j + 1
- Loop
- Else
- i = i + 1
- End If
- Loop
- 'Вывод результата
- k = 0
- For i = 0 To cnt - 1
- Text4 = Text4 & " " & S(i)
- Next
- Text4 = Text4 & ", количество элементов " & cnt
- End Sub
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д