(495) 925-0049, ITShop интернет-магазин 229-0436, Учебный Центр 925-0049
  Главная страница Карта сайта Контакты
Поиск
Вход
Регистрация
Рассылки сайта
 
 
 
 
 

Объект Collection(VBA) как альтернатива динамическому массиву

Источник: codingclub

При формировании перечня элементов(или значений) объект Collection может быть с успехом применен вместо динамического массива. В семейсто можно добавить(метод Add) или удалить(метод Remove) любое количество элементов. Причем, вставить новый элемент можно перед(после) существующим, т.е. можно получить ОТСОРТИРОВАННЫЙ перечень. Кроме того, на большом объеме данных есть существенное преимущество в скорострельности перед методом ReDim Preserve для динамического списка. Индексы в семействе начинаются с 1, а количество элементов определяется свойством Count.

Приведенная ниже функция формирует отсортированный список файлов или  вложенных папок согласно указанного шаблона. Здесь применяется метод быстрой сортировки. Новое значение сравнивается со значением из середины  диапазона, затем одна половина диапазона исключается и цикл повторяется.  Когда новое значение становится меньше первого или больше последнего в интервале, оно добавляется в семейство.

Объест Collection объявляется как Dim col As New Collection.
Использование New в данном случае обязательно.

В вызывающей процедуре можно применить 2 варианта:
Dim col As New Collection Здесь col - пустое семейство.
Set col = GetFilesList(......)
или
Dim col As Collection Здесь col - пустая ссылка на семейство.
Set col = GetFilesList(......)
Во втором варианте переменная может быть в состоянии Nothing, и обращение к свойству Count или любому методу семейства сгенерирует ошибку.
Специалисты настоятельно советуют использовать первый вариант всегда.
Другие возможности Collection:
Можно использовать конструкцию For Each ..... Next.
При добавлении нового элемента можно указать уникальный строковый ключ и затем использовать его при обращении к элементу. Например:
col.Add 100, "New"
MsgBox col("New") ( или col!New )
col.Remove "New"
К сожалению, прочитать значение ключа нельзя.
 
Function GetFilesList(Optional PathName As String, _
Optional FoldersOnly As Boolean) As Collection
' Функция возвращает отсортированное семейство имен файлов или
'вложенных папок (если установлен FoldersOnly).
' Аргумент PathName может принимать значение, распознаваемое
'функцией Dir().
On Error GoTo GetFilesList_err
Dim col As New Collection
Dim strFileName As String, strCompareFileName As String, _
i As Integer, j As Integer, MidPos As Integer

If FoldersOnly Then
strFileName = Dir$(PathName, vbDirectory)
Else
strFileName = Dir$(PathName)
End If

Do Until Len(strFileName) = 0
' В режиме поиска вложенных папок игнорирует папки ".",".." и

'файлы.
If FoldersOnly Then
'Если первый символ - "."(код 46), игнорируется.
If Asc(strFileName) = 46 Then GoTo NextFile
'Если отсутствует аттрибут vbDirectory, игнорируется.
If Not (GetAttr(PathName & strFileName) And vbDirectory) = _
vbDirectory Then GoTo NextFile
End If

i = 1
j = col.Count
'Если коллекция пуста - добавляет значение.
If j = 0 Then
col.Add strFileName
GoTo NextFile
End If

SearchBlock:
' Вычисляется средний индекс в диапазоне и извлекается
'соответствующее значение.
MidPos = (i + j) 2
strCompareFileName = col(MidPos)

' Имя нового файла сравнивается с текущим значением.
Select Case StrComp(strFileName, strCompareFileName, _
vbTextCompare)
Case -1 'strFileName < strCompareFileName
'Новое значение меньше текущего.
If MidPos <= i Then
' Если текущий индекс совпадает с начальным(< - для надежности),
'добавляется перед первым значением в диапазоне.
col.Add strFileName, , i
Else
'Диапазон ограничивается первой половиной и цикл повторяется.
j = MidPos - 1
GoTo SearchBlock
End If

Case 1 'strFileName > strCompareFileName
'Новое значение больше текущего.
If MidPos >= j Then
' Если текущий индекс совпадает с конечным(> - для надежности),
'добавляется после конечного значения в диапазоне.
col.Add strFileName, , , j
Else
'Диапазон ограничивается второй половиной и цикл повторяется.
i = MidPos + 1
GoTo SearchBlock
End If

' Case 0 strFileName = strCompareFileName
End Select
NextFile:
strFileName = Dir$(, vbDirectory)
Loop

Set GetFilesList = col

GetFilesList_exit:
Exit Function

GetFilesList_err:
Select Case Err.Number
Case 52
MsgBox "Путь к файлу(папке) указан неправильно.", vbCritical
Case 68
MsgBox "Устройство недоступно.", vbCritical
Case 76
MsgBox "Путь не найден.", vbCritical
Case Else
MsgBox Err & " - " & Err.Description, vbCritical, _
"GetFilesList"
End Select
Resume GetFilesList_exit
End Function

Ссылки по теме


 Распечатать »
 Правила публикации »
  Обсудить материал в конференции Microsoft »
Обсудить материал в конференции Дизайн, графика, обработка изображений »
Написать редактору 
 Рекомендовать » Дата публикации: 29.05.2008 
 

Магазин программного обеспечения   WWW.ITSHOP.RU
Microsoft Windows Professional 10 Russian Upgrade Academic OLP 1 License No Level
Microsoft SQL CAL 2017 Sngl OLP 1License NoLevel DvcCAL
Microsoft Office 365 Бизнес. Подписка на 1 рабочее место на 1 год
Microsoft Windows Professional 10 Sngl OLP 1 License No Level Legalization GetGenuine wCOA
Microsoft Windows Home 10 Russian Academic OLP 1 License No Level Legalization GetGenuine
 
Другие предложения...
 
Курсы обучения   WWW.ITSHOP.RU
 
Другие предложения...
 
Магазин сертификационных экзаменов   WWW.ITSHOP.RU
 
Другие предложения...
 
3D Принтеры | 3D Печать   WWW.ITSHOP.RU
 
Другие предложения...
 
Новости по теме
 
Рассылки Subscribe.ru
Информационные технологии: CASE, RAD, ERP, OLAP
Безопасность компьютерных сетей и защита информации
Новости ITShop.ru - ПО, книги, документация, курсы обучения
Программирование на Microsoft Access
CASE-технологии
Все о PHP и даже больше
Delphi - проблемы и решения
 
Статьи по теме
 
Новинки каталога Download
 
Исходники
 
Документация
 
Обсуждения в форумах
Настройка меню "Пуск" Windows 7 при помощи реестра (1)
Скажите пожалуйста, а как можно закрепить ярлыки программ с помощью твиков реестра в левой части...
 
3D редакторы, плюсы и минусы (2)
Одно из многих сотен бестолковых обобщений. Прости их господи, Васей Пупкиных
 
Где можно найти «Пакет анализа» для Excel ? (57)
Коллеги, подскажите, где можно скачать надстройку к Excel под названием «Пакет анализа», после...
 
Как изменить шрифт Wordpad? (3)
Как изменить шрифт Wordpad по умолчанию? Там Таймс, а мне, допустим, Ариал нужен. Можно ли...
 
Corel. Сохранение файла в старом формате. (25)
у меня есть горящий вопрос по Корелу и никто мне не может дать на него ответ. Я работаю в...
 
 
 



    
rambler's top100 Rambler's Top100