Visual Basic, .NET, ASP, VBScript
Новости | Примеры | Библиотека кодов | НеЧаВо | VBA | Справочник по VB | Справочник по WinAPI | ActiveX контролы | Статьи по VB | Мастерская разработчика | Форум VBNet | Яndex bar! | Голосование | Полезные программы | Магазин VBNet | Рассылка | Конкурсы | Юмор | Чат | Реклама на VBNet | Автора! | Ссылки | Бета-тестирование | Послать пример на сайт
 

   
   
     

Форум - VBA

Страница: 1 |

 

  Вопрос: Excel VBA. Помогите оптимизировать код макроса! Добавлено: 23.12.09 13:17  

Автор вопроса:  Andrei
Excel VBA. Помогите оптимизировать код макроса для создания массива из отдельных ячеек!

Проблема:
Есть набор экспериментальных данных размером несколько гигабайт.
Их просчет в 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_20091223b_TTest()
'
' IHNA_20091223b_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 ' От 0 до 600 (время 1200 мс)

I = NHZ - 1

While I >= 0 ' Герцы

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

' ttest

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

Ответить

  Ответы Всего ответов: 3  

Номер ответа: 1
Автор ответа:
 VβÐUηìt



Вопросов: 246
Ответов: 3333
  Web-сайт: смекаешь.рф
 Профиль | Цитата | #1 		Добавлено: 23.12.09 17:19
  1. While Y < (U - 1) ' число испытуемых минус один
  2. X = X - (NHZ + Z) * 2
  3. ActiveCell.Offset(-Y, -X).Select
  4. Selection.Copy
  5. Y = Y + 1
  6. ActiveCell.Offset(Y, X).Select
  7. ActiveSheet.Paste
  8. Wend
  9.  
  10. Мне кажется, что проблема в том, что эта часть макроса двигает активное окно, каждый раз, когда ищет следующую ячейку! И из-за этого сильно тормозит!
  11. Подскажите, можно ли как-то оптимизировать этот участок кода?
  12.  
  13. А вот полный код всего макроса:
  14.  
  15. Sub IHNA_20091223b_TTest()
  16. '
  17. ' IHNA_20091223b_TTest Макрос
  18. '
  19.  
  20. '
  21.  
  22. Dim S
  23. Dim X As Integer ' оператор указателя на начальную ячейку ввода значений TTesta
  24. Dim Y As Integer ' оператор смещений для формирования массива значений для TTesta
  25. Dim J As Integer ' оператор каретки по оси времени
  26. Dim I As Integer ' оператор каретки по оси герц
  27. Dim Z As Integer ' постоянный зазор между блоками
  28. Dim U As Integer ' число испытуемых
  29. Dim NT As Integer ' время сегмента
  30. Dim NHZ As Integer ' число частот
  31.  
  32. NT = 1200 ' время сегмента (должно делиться на два)
  33. NHZ = 28 ' число частот
  34. Z = 2 ' постоянный зазор между блоками
  35. U = 45 ' число испытуемых
  36.  
  37. ' начало формирования первого массива значений для ttesta
  38.  
  39. J = 0
  40.  
  41. While J < NT / 2 ' От 0 до 600 (время 1200 мс)
  42.  
  43. I = NHZ - 1
  44.  
  45. While I >= 0 ' Герцы
  46.  
  47. X = U * (NHZ + Z) * 2 - Z ' Offset
  48.  
  49. Range("A6").Select
  50.  
  51. ActiveCell.Offset(J, I).Select
  52. Selection.Copy
  53. ActiveCell.Offset(0, X).Select
  54. ActiveSheet.Paste
  55.  
  56. Y = 0
  57.  
  58. While Y < (U - 1) ' число испытуемых минус один
  59. X = X - (NHZ + Z) * 2
  60. ActiveCell.Offset(-Y, -X).Select
  61. Selection.Copy
  62. Y = Y + 1
  63. ActiveCell.Offset(Y, X).Select
  64. ActiveSheet.Paste
  65. Wend
  66.  
  67. ' начало формирования воторого массива значений для ttesta
  68.  
  69. X = U * (NHZ + Z) * 2 - (NHZ + Z) - 1
  70. Y = 0
  71.  
  72. Range("A6").Select
  73.  
  74. ActiveCell.Offset(J, I + NHZ + Z).Select
  75. Selection.Copy
  76. ActiveCell.Offset(0, X).Select
  77. ActiveSheet.Paste
  78.  
  79. While Y < (U - 1) ' число испытуемых минус один
  80. X = X - (NHZ + Z) * 2
  81. ActiveCell.Offset(-Y, -X).Select
  82. Selection.Copy
  83. Y = Y + 1
  84. ActiveCell.Offset(Y, X).Select
  85. ActiveSheet.Paste
  86. Wend
  87.  
  88. ' ttest
  89.  
  90. ActiveCell.Offset(-U + 1, 1).Select
  91. ActiveCell.FormulaR1C1 = "=TTEST(RC[-2]:R[" & U - 1 & "]C[-2],RC[-1]:R[" & U - 1 & "]C[-1],2,1)"
  92. S = ActiveCell
  93. ActiveCell = S
  94.  
  95. ' удаление уже ненужных массивов
  96.  
  97. Range(Cells(ActiveCell.Row, ActiveCell.Column - 2), Cells(ActiveCell.Row + U - 1, ActiveCell.Column - 1)).ClearContents
  98.  
  99. I = I - 1
  100.  
  101. Wend
  102.  
  103. J = J + 1
  104.  
  105. Wend
  106.  
  107. End Sub
  108.  

Ответить

Номер ответа: 2
Автор ответа:
 hip



Вопросов: 3
Ответов: 22
  Профиль | Цитата | #2 Добавлено: 23.12.09 18:20
По поводу движений активного окна: любое обновление окон приложения действительно занимает много времени, причем это касается не только скроллинга, но и изменения значения одной единственной ячейки, например. Поэтому обновление нужно отключать, вот так:

  1. Sub Test
  2.  
  3. 'отключаем
  4. Application.ScreenUpdating=False
  5.  
  6. 'здесь код твоей процедуры
  7.  
  8. 'и не забываем включить
  9. Application.ScreenUpdating=True
  10.  
  11. End sub


В итоге экран обновится всего один раз, в конце процедуры.
Потом, не стоит делать вот так:

  1.  
  2. ActiveCell.Offset(-Y, -X).Select
  3. Selection.Copy



можно вот так:
  1.  
  2. ActiveCell.Offset(-Y, -X).Copy



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

  1.  
  2. x=Cells(x1,y1).Value
  3. Cells(x2,y2).Value=x



зависит от ситуации, но в твоем случае очевидно лучше вообще напрямую:

  1.  
  2. Cells(x1,y1).Value=Cells(x2,y2).Value



Я признаться в код не вникал, но скорее всего в твоем случае, после того как ты учтешь то что выше написано работать программа все равно будет очень медленно.
В связи с этим такое соображение: раз ты все-равно удаляешь в конце все промежуточные таблицы, то не стоит зазря юзать объекты приложения, ведь на это уходит больше всего времени. Лучше делай так:

1. Определяешь в своей программе необходимые массивы
2. Считываешь данные с листа в эти массивы
3. Здесь же в своей программе анализируешь эти массивы
4. Выбрасываешь результат на лист
5. ????????????????
6. ПРОФИТ!

Ага?

Ответить

Номер ответа: 3
Автор ответа:
 Smith



ICQ: adamis@list.ru 

Вопросов: 153
Ответов: 3632
  Профиль | Цитата | #3 Добавлено: 23.12.09 19:56
Всё верно, ненужно выделять ячейки и копировать в буфер, ненужно скролить лист, лучше вообще свернуть эксель на время работы макроса.
Но модель экселя сама по себе очень медленная, даже если всё сделать правильно время обработки такого файла будет весьма значительным.
Лучше найти другую форму для хранения этих данных или хотябы конвертировать во чтото более другое перед обработкой

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам