PDA

Просмотр полной версии : Здравствуйте, помогите найти ошибки в коде и исправить их.



kOTeHOk_GaB
15.05.2010, 19:49
Отсортировать все элементы каждой строки матрицы по возрастанию в VB



Option Explicit
Public Type TMatrix '
MLine() As String
Size As Integer
End Type

Public Function GetMatrix(ByRef Matrix() As TMatrix) As Integer

Dim MatrixText As String
Dim ParLine As String
Dim i As Byte
Dim j As Byte
MatrixText = Форма1.Текст1.Text
Do While Len(MatrixText) > 0 ' организуем цикл с условием: пока длина строки переменной MatrixText>0
If InStr(1, MatrixText, Chr(13)) Then ' если в строке MatrixText найден ENTER, то
ParLine = Left(MatrixText, InStr(1, MatrixText, Chr(13)) - 1) ' заносим в переменную ParLine первую строку из MatrixText без ENTER-a
MatrixText = Right(MatrixText, Len(MatrixText) - InStr(1, MatrixText, Chr(10))) ' обрезаем у MatrixText первую строку (включая знак ENTER и Chr(10))
Else ' если ENTER не найден, то это последняя строка
ParLine = MatrixText
MatrixText = ""
End If
ReDim Preserve Matrix(j)

i = 0
Do While Len(ParLine) > 0
ReDim Preserve Matrix(j).MLine(i)
If InStr(1, ParLine, vbTab) > 0 Then ' если в строке ParLine найден Tab дальше, чем на первом месте, то
Matrix(j).MLine(i) = Left(ParLine, InStr(1, ParLine, vbTab) - 1)
ParLine = Right(ParLine, Len(ParLine) - InStr(1, ParLine, vbTab))
Else ' если Tab не найден, то следующим элементом строки матрицы будет остаток ParLine
Matrix(j).MLine(i) = ParLine ' записываем в исходную матрицу последний элемент j-й строки
ParLine = "" ' обнуляем ParLine для выхода из цикла
End If ' конец условия выборки элементов строки в матрицу
i = i + 1 ' увеличение счетчика количества символов в строке
Loop ' конец цикла выборки символов из строки
Matrix(j).Size = i ' запись количества символов в j-й строке в исходный массив
j = j + 1 ' увеличение количества строк в исходной матрице
Loop ' конец цикла выборки строк в исходную матрицу
GetMatrix = j ' формирование результата работы процедуры, т.е. возвращение количества строк в сформированной исходной матрице
End Function ' конец функции

Public Function CreateOutMatrix(ByRef OutMatrix() As TMatrix, ByRef Matrix() As TMatrix, ByRef MatrixSize As Integer) As Integer
' объявление локальных переменных i, j
Dim i As Integer
Dim j As Integer
' сначала формируем размер итоговой матрицы и заполняем её как исходную
ReDim Preserve OutMatrix(MatrixSize) ' изменяем размерность конечной матрицы, т.е. задаем - сколько в ней будет строк
For j = 0 To MatrixSize - 1 ' организуем цикл по количеству строк
For i = 0 To Matrix(j).Size - 1 ' организуем цикл по количеству элементов в строке
ReDim Preserve OutMatrix(j).MLine(i) ' изменяем количество символов в i-й строке итоговой матрицы
OutMatrix(j).MLine(i) = Matrix(j).MLine(i) ' присваиваем значение элементу итоговой матрицы значение из исходной матрицы
OutMatrix(j).Size = Matrix(j).Size ' запись количества символов в i-й строке в итоговый массив
Next ' конец цикла по количеству элементов в строке
Next ' конец цикла по количеству строк

stolb_sort = Val(Форма1.Текст3.Текст1) - 1 ' запоминаем номер столбца для сортировки
If (MatrixSize > 0) Then ' ставим условие: выполнять преобразования если в матрице есть строки
nom_el_sled = 0 ' обнуляем номер для вставки в столбец сортировки
If (0 <= stolb_sort) And (stolb_sort <= OutMatrix(0).Size - 1) Then
For kol_str = 0 To MatrixSize - 1
max_chislo = Val(Matrix(str_sort).MLine(0))
For i = 0 To OutMatrix(0).Size - 1
If max_chislo >= Val(OutMatrix(stolb_sort).MLine(i)) Then
max_chislo = Val(OutMatrix(stolb_sort).MLine(i))
nom_max_el = i ' запоминаем номер максимального элемента в столбце
End If ' конец условия смены максимального элемента
Next ' конец цикла по формированию максимального элемента
OutMatrix(stolb_sort).MLine(nom_el_sled) = max_chislo
OutMatrix(stolb_sort).MLine(nom_max_el) = Str(Val(OutMatrix(stolb_sort).MLine(nom_max_el)) * 1000)
nom_el_sled = nom_el_sled - 1 ' уменьшение номера элемента в отсортированной матрице
Next ' конец цикла по количеству строк для сортировки всех элементов столбца
Else ' если столбца не существует, то выдаем сообщение
MsgBox "В таблице нет сттолбца с таким номером !"
End If
End If
CreateOutMatrix = MatrixSize
End Function