Сортировка (по выбранному параметру)

1. Выбор параметра сортировки и результат:

Листинг

'====================================================================================

'Сортировка по заданному параметру

'====================================================================================

Private Sub CommandButton5_Click ()

'--------ОПИСАНИЕ ВНУТРЕННИХ ПЕРЕМЕННЫХ----------

Dim Trips () As Trip_inf ' массив структур с данными о каждом рейсе

Dim i, j As Integer ' Счетчики для циклов

Dim work As String ' рабочая строка

'-------ЗАНОСИМ ИНФОРМАЦИЮ В ПЕРЕМЕННЫЕ----------

i = 0 ' количество записей

Do '(нужно определить сколько всего

‘строк)

i = i + 1 ' Считаем очередную строку

work = Лист1.Cells ( i, 1). Value ' Считываем строку

If ( work = "" ) Then ' Если она пустая...

Exit Do '...то записей больше нет

End If

Loop Until ( False )

ReDim Trips ( i - 3) ' Изменяем размерность массива

For j = 0 To i - 3 ' Считываем все данные в массив

Trips ( j ). train_id = Лист1.Cells ( j + 2, 1)

Trips ( j ). destination = Лист1.Cells ( j + 2, 2)

Trips ( j ). start_date = Лист1.Cells ( j + 2, 3)

Trips ( j ). st_time = Лист1.Cells ( j + 2, 4)

Trips ( j ). fin_time = Лист1.Cells ( j + 2, 5)

Trips ( j ). tic_coupe = CStr ( Лист1.Cells ( j + 2, 6))

Trips ( j ). tic_reserve = CStr ( Лист1.Cells ( j + 2, 7))

Next

'-----ДЕЙСТВИЯ ЗАВИСЯТ ОТ ВЫБОРА ПОЛЬЗОВАТЕЛЯ----

If ( OptionButton1.Value = True ) Then

GoTo m_sort_train_id ' Сортировка по номеру поезда

End If

If ( OptionButton2.Value = True ) Then

GoTo m_sort_destination ' Сортировка по станции назначения

End If

If ( OptionButton3.Value = True ) Then

GoTo m_sort_start_date ' Сортировка по дате отправления

End If

If ( OptionButton4.Value = True ) Then

GoTo m_sort_st_time ' Сортировка по времени отправления

End If

If ( OptionButton5.Value = True ) Then

GoTo m_sort_fin_time ' Сортировка по времени прибытия

End If

If ( OptionButton6.Value = True ) Then

GoTo m_sort_tic_coupe ' Сортировка по количеству мест в

‘купе

End If

If ( OptionButton7.Value = True ) Then

GoTo m_sort_tic_reserve ' Сортировка по количеству мест в

‘плацкарте

End If

'----------Сортировка текстовых полей:-----------

Dim x As Trip_inf

m_sort_train_id: ' Сортировка по номеру поезда

For i = 1 To UBound ( Trips )

j = UBound ( Trips )

Do

If Trips ( j - 1). train_id > Trips ( j ). train_id Then

x = Trips ( j - 1)

Trips ( j - 1) = Trips ( j )

Trips ( j ) = x

End If

j = j - 1

Loop While j >= i

Next i

GoTo m_success ' Сортировка завершена

m_sort_destination: ' Сортировка по станции назначения

For i = 1 To UBound ( Trips )

j = UBound ( Trips )

Do

If Trips ( j - 1). destination > Trips ( j ). destination Then

x = Trips ( j - 1)

Trips ( j - 1) = Trips ( j )

Trips ( j ) = x

End If

j = j - 1

Loop While j >= i

Next i

GoTo m_success ' Сортировка завершена

m_sort_start_date: ' Сортировка по дате отправления

For i = 1 To UBound ( Trips )

j = UBound ( Trips )

Do

If Trips ( j - 1). start_date > Trips ( j ). start_date Then

x = Trips ( j - 1)

Trips ( j - 1) = Trips ( j )

Trips ( j ) = x

End If

j = j - 1

Loop While j >= i

Next i

GoTo m_success ' Сортировка завершена

m_sort_st_time: ' Сортировка по времени отправления

For i = 1 To UBound ( Trips )

j = UBound ( Trips )

Do

If Trips ( j - 1). st_time > Trips ( j ). st_time Then

x = Trips ( j - 1)

Trips ( j - 1) = Trips ( j )

Trips ( j ) = x

End If

j = j - 1

Loop While j >= i

Next i

GoTo m_success ' Сортировка завершена

m_sort_fin_time: ' Сортировка по времени прибытия

For i = 1 To UBound ( Trips )

j = UBound ( Trips )

Do

If Trips ( j - 1). fin_time > Trips ( j ). fin_time Then

x = Trips ( j - 1)

Trips ( j - 1) = Trips ( j )

Trips ( j ) = x

End If

j = j - 1

Loop While j >= i

Next i

GoTo m_success ' Сортировка завершена

m_sort_tic_coupe: ' Сортировка по количеству мест в купе

For i = 1 To UBound ( Trips )

j = UBound ( Trips )

Do

If Trips ( j - 1). tic_coupe > Trips ( j ). tic_coupe Then

x = Trips ( j - 1)

Trips ( j - 1) = Trips ( j )

Trips ( j ) = x

End If

j = j - 1

Loop While j >= i

Next i

GoTo m_success ' Сортировка завершена

m_sort_tic_reserve: ' Сортировка по количеству мест в плацкарте

For i = 1 To UBound ( Trips )

j = UBound ( Trips )

Do

If Trips ( j - 1). tic_reserve > Trips ( j ). tic_reserve Then

x = Trips ( j - 1)

Trips ( j - 1) = Trips ( j )

Trips ( j ) = x

End If

j = j - 1

Loop While j >= i

Next i

GoTo m_success ' Сортировка завершена

'----ДИАГНОСТИКА УСПЕШНОГО ВЫПОЛНЕНИЯ ЗАДАЧИ-----

m_success:

Worksheets ( "Лист1" ). Cells.ClearContents ' Очистка листа №1

' Заполняем шапку таблицы:

Лист1.Cells (1, 1). Value = "Номер поезда"

Лист1.Cells (1, 2). Value = "Станция назначения"

Лист1.Cells (1, 3). Value = "Дата отправления"

Лист1.Cells (1, 4). Value = "Время отправления"

Лист1.Cells (1, 5). Value = "Время прибытия"

Лист1.Cells (1, 6). Value = "Мест в купе"

Лист1.Cells (1, 7). Value = "Мест в плацкарте"

For i = 0 To UBound ( Trips )

Лист1.Cells ( i + 2, 1). Value = Trips ( i ). train_id

Лист1.Cells ( i + 2, 2). Value = Trips ( i ). destination

Лист1.Cells ( i + 2, 3). Value = Trips ( i ). start_date

Лист1.Cells ( i + 2, 4). Value = Trips ( i ). st_time

Лист1.Cells ( i + 2, 5). Value = Trips ( i ). fin_time

Лист1.Cells ( i + 2, 6). Value = Trips ( i ). tic_coupe

Лист1.Cells ( i + 2, 7). Value = Trips ( i ). tic_reserve

Next i

End Sub

Дата добавления: 2015-10-29