Тестирование скорости чтения и записи диапазонов

Листинг 2.44. Тестирование скорости чтения и записи диапазонов

Sub TableSpeedTest()

Dim alngData() As Long ' Массив с числами

Dim lngCount As Long ' Количество элементов в массиве

Dim dtStart As Date ' Хранит время (и даже дату) начала _

тестирования

Dim strArrayToTable As String ' Время записи в таблицу

Dim strTableToArray As String ' Время чтения из таблицы

Dim strMessage As String

Dim i As Long

' Подготовка диапазона ячеек

Range(" A: A").ClearContents

' Ввод размера массива, формирование массива заданного размера

lngCount = InputBox(" Введите количество элементов")

ReDim alngData(1 To lngCount)

' Заполнение массива данными

For i = 1 To lngCount

alngData(i) = i

Next i

' Перенос массива в таблицу

Application.ScreenUpdating = False

dtStart = Timer

For i = 1 To lngCount

Cells(i, 1) = i

Next i

strArrayToTable = Format(Timer - dtStart, " 00: 00")

' Чтение данных из таблицы обратно в массив

dtStart = Timer

For i = 1 To lngCount

alngData(i) = Cells(i, 1)

Next i

strTableToArray = Format(Timer - dtStart, " 00: 00")

Application.ScreenUpdating = True

' Вывод на экран результатов тестирования

strMessage = " Запись: " & strArrayToTable & vbCrLf & _

" Чтение: " & strTableToArray

MsgBox strMessage,, lngCount & " элементов"

End Sub

Разработка и применение полезных пользовательских функций

Объединение данных диапазона

Листинг 2.45. Функция Couple

Function Couple(Diapazon)

' Объединение данных, содержащихся в ячейках диапазона _

Diapazon (разделитель между значениями - пробел)

' iCell - текущая ячейка

For Each iCell In Diapazon

' Сцепляются данные только заполненных ячеек

If IsEmpty(iCell) < > True Then

' Добавление значения ячейки в выходную строку

If Couple = " " Then

Couple = iCell

Else

Couple = Couple & " " & iCell

End If

End If

Next

End Function

Объединение данных с учетом форматов

Листинг 2.46. Функция CoupleFormat

Function CoupleFormat(Diapazon)

' Объединение текстовых данных, содержащихся в ячейках _

диапазона Diapazon (разделитель между значениями - пробел)

' iCell - текущая ячейка

For Each iCell In Diapazon

' Сцепляются данные только заполненных ячеек

If IsEmpty(iCell) < > True Then

' Добавление текста ячейки в выходную строку

If CoupleFormat = " " Then

CoupleFormat = iCell.Text

Else

CoupleFormat = CoupleFormat & " " & iCell.Text

End If

End If

Next

End Function