Combine As Boolean 'совместительство
Post As String * 30
Degree As String * 10
End Type
Перепишем теперь записи таблицы в файл произвольного доступа. При открытии файла указывается Random - произвольный доступ к элементам, и обязательно - длина элементов, образующих его. Запись в файл осуществляется функцией Put, в которой необходимо указать номер файла, позицию и переменную из которой производится запись в файл. Позиция может быть пропущена, тогда запись производится в текущую позицию[4].
Sub NewFile()
Dim i As Integer
Dim MyRecord As Employee ' Объявляем переменную типа запись
Open "bd.dat" For Random As #1 Len = Len(MyRecord)
For i = 2 To Application.CountA(ActiveSheet.Columns(1)) ' для всех записей таблицы
With MyRecord 'считываеv из i-ой строки запись о сотруднике
.ID = Cells(i, 1)
.Family = Cells(i, 2)
.Name = Cells(i, 3)
.LenService = Cells(i, 4)
.Category = Cells(i, 5)
.BirthDay = Cells(i, 6)
.Combine = Cells(i, 7)
.Post = Cells(i, 8)
.Degree = Cells(i, 9)
End With
Put #1, i - 1, MyRecord ' Записываем запись в файл
Next i
Close #1 ' Закрываем файл
End Sub
Откройте созданный файл в блокноте и посмотрите результат. Сравните объем созданного файла и файла Execel, состоящего из одного листа с таблицей. Хранение данных в файлах произвольного доступа имеет свои преимущества - экономию памяти, но усложняет извлечение данных из них.
2. Следующий этап - это чтение из файла. Предположим, что у нас есть файл с данными и мы хотим его просмотреть на листе Excel. Для этого необходимо подготовить форму таблицы - ее заголовок, считать и отобразить записи из файла произвольного доступа. Чтение осуществляет функция Get, в которой указывается номер файла, позиция считывания[5] и переменная, в которую заносятся считанные данные. Проиллюстрируем сказанное:
|
|
|
Sub FileInTable()
Dim i As Integer
Dim MyRecord As Employee ' Объявляем переменную типа запись
'Названия столбцов таблицы берем из массива
Range("A1:I1").Value = Array("n/n", "ФАМИЛИЯ", "ИМЯ", "СТАЖ", "РАЗРЯД",_ "ДАТА РОЖДЕНИЯ", "СОВМЕСТИТЕЛЬСТВО", "ДОЛЖНОСТЬ", "СТЕПЕНЬ")
Заголовок 'Запускаем макрос форматирования «шапки» таблицы и закрепления области
Примечания 'добавляем примечания к заголовкам
'открываем файл произвольного доступа при этом обязательно указывается длина одной записи
Open "bd.dat" For Random As #1 Len = Len(MyRecord)
i = 1
Do
Get #1, i, MyRecord ' Читаем одну запись
If EOF(1) Then 'если конец файла - выходим из цикла чтения элементов
Exit Do
Else
With MyRecord 'переносим прочитанные поля на лист Excel
Cells(i + 1, 1) = .ID
Cells(i + 1, 2) = .Family
Cells(i + 1, 3) = .Name
Cells(i + 1, 4) = .LenService
Cells(i + 1, 5) = .Category
Cells(i + 1, 6) = .BirthDay
Cells(i + 1, 7) = .Combine
Cells(i + 1, 8) = .Post
Cells(i + 1, 9) = .Degree
End With
|
|
|
i = i + 1
End If
Loop
Close #1 ' Закрываем файл
End Sub
Эта процедура использует ранее записанный макрос Заголовок[6] и процедуру Примечания. Процедура Примечания добавляет к заголовкам таблицы примечания. Это можно сделать, используя Вставка\Примечание или программно:
Public Sub Примечания()
Range("1:1").ClearComments ‘очистка примечаний первой строки
Range("A1").AddComment ‘добавить примечание к заголовку первого столбца
Range("A1").Comment.Visible = False
Range("A1").Comment.Text "Номер сотрудника"
‘…
End Sub
Самостоятельно напишите код для добавления примечаний к остальным столбцам.
3. Задача: увеличить на 1 разряд категорию работнику кафедры, который проработал дольше всех.
Sub ПоискВетерана()
Dim max As Integer, nmax As Integer, i As Integer
Dim MyRecord As Employee ' Объявляем переменную типа запись
Open "bd.dat" For Random As #1 Len = Len(MyRecord)
i = 1
max = -1
Do
Get #1, , MyRecord ' Читаем одну запись
If EOF(1) Then 'если конец файла - выходим из цикла чтения элементов
Exit Do
Else
If MyRecord.LenService > max Then
max = MyRecord.LenService
nmax = i
End If
i = i + 1
End If
Loop
Get #1, nmax, MyRecord ' Читаем запись с максимальным стажем
MsgBox ("Дольше всего работает " & MyRecord.LenService & " гг " & Trim(MyRecord.Family) & " " & Trim(MyRecord.Name))
|
|
|
MyRecord.Category = MyRecord.Category + 1 'Повышаем категорию
Дата добавления: 2018-08-06; просмотров: 459; Мы поможем в написании вашей работы! |
Мы поможем в написании ваших работ!