Developing.ru

Помогите оптимизировать макрос!

Проблема:
Есть набор экспериментальных данных размером несколько гигабайт.
Их просчет в Excel'е с тем макросом, что у меня есть, занимает около месяца!!!

Суть в том, что для анализа данных используется Excel'евская формула TTEST, которая понимает только массивы значений.

ActiveCell.FormulaR1C1 = "=TTEST(RC[-2]:R[" & U - 1 & "]C[-2],RC[-1]:R[" & U - 1 & "]C[-1],2,1)"

Поэтому сначала надо сформировать массивы из отдельных ячеек расположенных в разных местах.
Эту задачу выполняет эта часть макроса, которая занимает порядка 90% просчетного времени!

While Y < (U - 1) ' число испытуемых минус один
X = X - (NHZ + Z) * 2
ActiveCell.Offset(-Y, -X).Select
Selection.Copy
Y = Y + 1
ActiveCell.Offset(Y, X).Select
ActiveSheet.Paste
Wend

Мне кажется, что проблема в том, что этот макрос двигает окно, каждый раз, когда ищет следующую ячейку! И из-за этого сильно тормозит!
Подскажите, можно ли как-то оптимизировать этот участок кода?

А вот полный код макроса:

Sub IHNA_20091223_TTest()
'
' IHNA_20091223_TTest Макрос
'

'

Dim S
Dim X As Integer ' оператор указателя на начальную ячейку ввода значений TTesta
Dim Y As Integer ' оператор смещений для формирования массива значений для TTesta
Dim J As Integer ' оператор каретки по оси времени
Dim I As Integer ' оператор каретки по оси герц
Dim Z As Integer ' постоянный зазор между блоками
Dim U As Integer ' число испытуемых
Dim NT As Integer ' время сегмента
Dim NHZ As Integer ' число частот

NT = 1200 ' время сегмента (должно делиться на два)
NHZ = 28 ' число частот
Z = 2 ' постоянный зазор между блоками
U = 45 ' число испытуемых

' начало формирования первого массива значений для ttesta

J = 0

While J < NT / 2 ' From 0 to Т=600 (время 1200 мс)

I = NHZ - 1

While I >= 0 ' From HZ to ... Герцы

X = U * (NHZ + Z) * 2 - Z ' Offset

Range("A6").Select

ActiveCell.Offset(J, I).Select
Selection.Copy
ActiveCell.Offset(0, X).Select
ActiveSheet.Paste

Y = 0

While Y < (U - 1) ' число испытуемых минус один
X = X - (NHZ + Z) * 2
ActiveCell.Offset(-Y, -X).Select
Selection.Copy
Y = Y + 1
ActiveCell.Offset(Y, X).Select
ActiveSheet.Paste
Wend

' начало формирования воторого массива значений для ttesta

X = U * (NHZ + Z) * 2 - (NHZ + Z) - 1
Y = 0

Range("A6").Select

ActiveCell.Offset(J, I + NHZ + Z).Select
Selection.Copy
ActiveCell.Offset(0, X).Select
ActiveSheet.Paste

While Y < (U - 1) ' число испытуемых минус один
X = X - (NHZ + Z) * 2
ActiveCell.Offset(-Y, -X).Select
Selection.Copy
Y = Y + 1
ActiveCell.Offset(Y, X).Select
ActiveSheet.Paste
Wend

ActiveCell.Offset(-U + 1, 1).Select
ActiveCell.FormulaR1C1 = "=TTEST(RC[-2]:R[" & U - 1 & "]C[-2],RC[-1]:R[" & U - 1 & "]C[-1],2,1)"
S = ActiveCell
ActiveCell = S

Range(Cells(ActiveCell.Row, ActiveCell.Column - 2), Cells(ActiveCell.Row + U - 1, ActiveCell.Column - 1)).ClearContents

I = I - 1

Wend

J = J + 1

Wend

End Sub

Оптимизировать можно, конечно.
Первым делом избавьтесь от всех Select-ов.

К примеру, данный фрагмент кода будет работать намного быстрее, если его записать в таком виде: А так - ещё быстрее:

Ну и так далее:
Но, чтобы добиться хорошей скорости для такого объёма данных, необходимо кое-что ещё:

1) Переписать код почти "с нуля"
Макрос будет работать гораздо быстрее, если сначала считать все нужные данные с листа в массив (одна строка кода)
потом обработать массив, и затем записать массив обратно на лист (опять одной строкой кода)
Кроме того, формулы и значения можно заносить сразу в большой диапазон ячеек, а не перебирать ячейки по одной.

2) Оптимизировать алгоритм

3) Отключать пересчёт формул и обновление экрана на время работы макроса:

В итоге можно снизить время выполнения макроса до нескольких секунд. (максимум - несколько минут)

PS: Судя по весьма скромным значениям в исходных данных

NT = 1200 ' время сегмента (должно делиться на два)
NHZ = 28 ' число частот
Z = 2 ' постоянный зазор между блоками
U = 45 ' число испытуемых

достаточно будет и 2-3 секунд.