Данное, которое находится в составе записи и значения, которого должны учитываться при сортировке, называется ключом.

Для сортировки записей по заданному ключевому полю удобнее использовать ЗАПИСИ:

1. Первые две строки файла - заголовок и «Шапка» в сортировке не участвуют.

2. Третья и последующие строки преобразуются в ЗАПИСИ типа param:

Type param

prop As String

vol(7) As Single

End Type

Например:

Разделителем при преобразовании в ЗАПИСЬ является знак горизонтальной табуляции (HT)

Например:

Аммиак NH3HT15,0HT28,0HT15HT79

Подпрограмма разделения строк исходного файла на поля:

Sub seps(str As String, par As param, howpar As Integer)

Dim p As Integer, q As Integer, r As Integer

Dim dlina As Integer

Dim sp As String, smb As String

Dim HT As String * 1

HT = Chr(9)

dlina = Len(str)

If dlina = 0 Then

Exit Sub

End If

r = InStr(str, HT)

par.prop = Left(str, r - 1)

sp = Right(str, dlina - r) & HT

dlina = dlina - r + 1

p = 1: q = 0

Do While p < dlina

r = InStr(p, sp, HT)

smb = Mid(sp, p, r - p)

If smb = "-" Then

par.vol(q) = 0

Else:

par.vol(q) = CSng(smb)

End If

q = q + 1

p = r + 1

Loop

howpar = q

End Sub

Алгоритм сортировки

Решение задачи сортировки файла разбивается на два этапа.

На первом этапе создаётся вспомогательный вектор. На втором этапе формируется выходной файл: первой выводится запись, номер которой 0 затем выводится запись, номер которой 1 и т. д.

Первый этап. Описание алгоритма формирования вспомогательного вектора.

Исходные данные: volVector - массив записей, в составе каждой записи имеется поле ключа Vol(1). В массиве volVector содержится N элементов. доступ к ключу j-ого элемента обозначается так: volVector(j).Vol(1). Тип данного Vol(1) допускает сравнение на равно, больше и меньше. В результате выполнения алгоритма, определяются значения элементов вспомогательного вектора intMesto. В алгоритме используется вспомогательный логический вектор размером N. flag(j)=True обозначает, что элемент volVector(j) доступен для просмотра, но, если flag(j)=False, то элемент volVector(j) исключается из просмотра. В исходном состоянии все элементы вектора flag устанавливаются в значение True. Вспомогательная переменная voltemp хранит текущее минимальное значение Vol(1). Константа voltemp имеет тот же тип, что и ключ Vol(1), значение voltemp заведомо больше любого ключа Vol(1).

1. Для каждого i от 0 до N выполнять шаги 1....5. (Индекс i определяет место записи в выходном файле.)

2. Установить voltemp равным 99999 и перейти к шагу 3.

3. Для каждого j от 0 до N выполнять шаг 4. (В этом цикле отыскивается претендент на место i.)

4. Если flag(j)=True и volVector(j).Vol(1)<=voltemp, выполнить voltemp < volVector(j).Vol(1); kl<j. (Если элемент volVector(j) доступен и его ключ volVector(j).Vol(1) меньше, чем текущий минимум voltemp, то заменить значение текущего минимума и запомнить его место. Доступность элемента volVector(j) определяется значением True элемента flag(j).

5. Выполнить intMesto(i)<kl; flag(kl)<False. (Минимальное значение из множества доступных ключей найдено в записи с индексом kl. Значение kl записывается в intMesto(i), kl-ый элемент вектора volVector помечается как недоступный, исключается из дальнейших действий.)

Второй этап сортировки файла - вывод в рабочий лист Excel и запись в файл на диске.

(mas-массив исходных записей, mm-вспомогательный массив, sk-массив исходных строк)

For q = 0 To h

Cells(q + 3, 1) = mas(mm(q)).prop

For i = 0 To hp - 1

Cells(q + 3, i + 2) = mas(mm(q)).vol(i)

Next i

Print #nf2, sk(mm(q) + 2)

Next q

Подпрограмма первого этапа сортировки (создание вспомогательного массива intMesto):

Sub sort(volVector() As param, intMesto() As Integer, h As Integer)

Dim i As Integer, j As Integer, kl As Integer

Dim highIndex As Integer, lj As Integer

Dim voltemp As Single

Dim flag() As Boolean

h = UBound(volVector)

ReDim intMesto(h)

highIndex = UBound(volVector)

ReDim flag(highIndex)

For i = 0 To highIndex

flag(i) = True

Next i

For i = 0 To highIndex

voltemp = 99999

For j = 0 To highIndex

If flag(j) Then

If volVector(j).vol(1) <= voltemp Then

'если volvector(j) будет меньше или равно voltemp

'то значение текущего минимума voltemp, будет

'заменено на элемент volvector(j)

voltemp = volVector(j).vol(1)

kl = j

End If

End If

Next j

intMesto(i) = kl

flag(kl) = False

Next i

End Sub

Подпрограмма второго этапа сортировки - вывод результата в рабочий лист Excel и запись в файл на диске:

Sub OutputData(name As String, sk() As String, mm() As Integer, h As Integer, hp As Integer, nf2 As Integer, str As String, mas() As param)

Dim i As Integer, q As Integer

Open name For Output As nf2

Print #nf2, sk(0)

Print #nf2, sk(1)

Cells(1, 1) = sk(0)

For i = 0 To hp

Cells(2, i + 1) = str(i)

Next i

For q = 0 To h

Cells(q + 3, 1) = mas(mm(q)).prop

For i = 0 To hp - 1

Cells(q + 3, i + 2) = mas(mm(q)).vol(i)

Next i

Print #nf2, sk(mm(q) + 2)

Next q

Close #nf2

End Sub

5. Структурная иерархическая схема программы

42

6. Листинг программы

Модуль 1

Главная программа

'Главная программа

'Чалков С.А. 10.06.2010

Sub Core()

Dim st() As String, sk() As String

Dim mm() As Integer, mas() As param

Dim h As Integer, кодировка As String

Dim msg As String

Dim q As Integer, hp As Integer

Dim nf1 As Integer, nf2 As Integer

Dim k As Integer, i As Integer

Dim str As String, indx As Integer

Dim name1 As String, name2 As String

name1 = "d:\ВоспламеняемостьГазов.txt"

name2 = "d:\vba\Save.txt"

nf1 = FreeFile(): nf2 = FreeFile()

Worksheets(1).Select

Call InputData(name1, nf1, st, sk, k)

Call FindCP(st, кодировка, msg, indx): MsgBox кодировка: MsgBox msg

Call Decoder(st, indx, k, sk)

Call ConvertToRecord(sk, k, str, mas, hp)

Call sort(mas, mm, h)

Call OutputData(name2, sk, mm, h, hp, nf2, str, mas)

End Sub

Модуль 2

Ввод данных из файла в память

Sub InputData(name As String, nf1 As Integer, st() As String, sk() As String, k As Integer)

k = 0

Open name For Input As nf1

Do Until EOF(nf1)

ReDim Preserve st(k)

Line Input #nf1, st(k)

ReDim Preserve sk(k)

sk(k) = st(k)

k = k + 1

Loop

Close #nf1

End Sub

Модуль 3

Проверка принадлежности текста к одной из шести кодовых таблиц

Sub FindCP(stroky() As String, msg1 As String, msg2 As String, index As Integer)

Dim s As Integer, z As Integer

Dim symb As String * 1

Dim kod As Byte

Dim scp(7) As codepage

Dim ks As String, ks1 As String

Dim ks2 As String, ne As String

ks = "Ваш текст предположительно имеет кодировку "

ne = "не "

ks1 = "Требуется "

ks2 = "Перекодировка "

For s = 0 To UBound(stroky)

For z = 1 To Len(stroky(s))

symb = Mid(stroky(s), z, 1)

kod = Asc(symb)

If cp1(kod) Then scp(0).vol = scp(0).vol + 1: scp(0).name = "КОИ-8R"

If cp2(kod) Then scp(1).vol = scp(1).vol + 1: scp(1).name = "Cp1251"

If cp3(kod) Then scp(2).vol = scp(2).vol + 1: scp(2).name = "OEM"

If cp4(kod) Then scp(3).vol = scp(3).vol + 1: scp(3).name = "Cp866"

If cp5(kod) Then scp(4).vol = scp(4).vol + 1: scp(4).name = "Mac"

If cp6(kod) Then scp(5).vol = scp(5).vol + 1: scp(5).name = "ISO"

If cp71(symb) Then scp(6).vol = scp(6).vol + 1: scp(6).name = "Unicode"

Next z

Next s

z = 0

For s = 0 To 6

If scp(s).vol >= z Then

z = scp(s).vol: index = s

End If

Next s

'При совпадении счетчиков "КОИ-8R" и "cp1251" кодировка текста определяется как "cp1251"

If ((scp(0).vol = scp(1).vol) And index <= 1) Then index = 1

If index = 1 Then

msg1 = ks & scp(index).name

msg2 = ks2 & ne & LCase(ks1)

Else:

msg1 = ks & scp(index).name

msg2 = ks1 & LCase(ks2)

End If

End Sub

Модуль 4

Процедура выбора варианта перекодировки (КОИ-8R, 1251, OEM, 866, MAC, Unicode)

Sub Decoder(Fmas() As String, IndxCP As Integer, r As Integer, Smas() As String)

Dim i As Integer

Dim n As Integer

Dim Stroka As String

Dim OutStr As String

Dim smb As String

Dim code As Byte

If IndxCP = 1 Then Exit Sub 'если кодировка cp1251, то выход из процедуры без перекодирования

If IndxCP = 6 Then

Call DecUnicodeTo1251(Fmas, Smas)

Exit Sub

End If

ReDim Smas(r - 1)

For i = 0 To r - 1

Stroka = Fmas(i)

OutStr = ""

For n = 1 To Len(Stroka)

smb = Mid(Stroka, n, 1)

code = Asc(smb)

Select Case IndxCP

Case 0

OutStr = OutStr & Chr(cpKoiTo1251(code))

Case 2

OutStr = OutStr & Chr(cpOEMTo1251(code))

Case 3

OutStr = OutStr & Chr(cp866To1251(code))

Case 4

OutStr = OutStr & Chr(cpMACTo1251(code))

Case 5

OutStr = OutStr & Chr(cpISOTo1251(code))

End Select

Next n

Smas(i) = OutStr

Next i

End Sub

Модуль 5

Проверка необходимости преобразования строк в записи пользовательского типа

Страницы: 1, 2, 3, 4