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

[zx407user]

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

Проблема:
Есть набор экспериментальных данных размером несколько гигабайт.
Их просчет в 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

[EducatedFool]

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

К примеру, данный фрагмент кода

Код: Выделить всё

            Range("A6").Select

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

будет работать намного быстрее, если его записать в таком виде:

Код: Выделить всё

            Range("A6").Offset(J, I).[B]Copy[/B]  Range("A6").Offset(0, X)

А так - ещё быстрее:

Код: Выделить всё

    [color=darkblue]With[/color] Range("A6")
        .Offset(0, X) = .Offset(J, I)
        [color=green]' ...[/color]
    [color=darkblue]End[/color] [color=darkblue]With[/color]

Ну и так далее:

Код: Выделить всё

            [color=darkblue]While[/color] Y < (U - 1)    [color=green]' число испытуемых минус один[/color]
                X = X - (NHZ + Z) * 2
                Range("A6").Offset(-Y, -X).Copy Range("A6").Offset(Y + 1, X)
                Y = Y + 1
            [color=darkblue]Wend[/color]

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

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

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

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

Код: Выделить всё

[color=darkblue]Sub[/color] IHNA_20091223_TTest()
    [color=green]' отключаем автоматический пересчёт формул[/color]
    Application.Calculation = xlCalculationManual
    [color=green]' отключаем перерисовку экрана[/color]
    Application.ScreenUpdating = [color=darkblue]False[/color]

            [color=green]' здесь весь ваш код[/color]

    [color=green]' включаем  обратно автоматический пересчёт формул[/color]
    Application.Calculation = xlCalculationAutomatic
    [color=green]' включаем  обратно перерисовку экрана[/color]
    Application.ScreenUpdating = [color=darkblue]True[/color]
[color=darkblue]End[/color] [color=darkblue]Sub[/color]

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

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

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

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