Форум программистов, компьютерный форум, киберфорум
Наши страницы
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.50/4: Рейтинг темы: голосов - 4, средняя оценка - 4.50
Саша(Я)
0 / 0 / 0
Регистрация: 01.03.2011
Сообщений: 5
1

Очень медленное копирование?

10.03.2013, 17:13. Просмотров 631. Ответов 5
Метки нет (Все метки)

Здравствуйте,уважаемые форумчане.Я написал не сложный макрос,но при копировании такого количества строк ,он работает больше пяти минут на одном листе.Пробовал делать на массиве are(),но как для массива are указать , переделать эту строку , не получается: d = Cells(a + k, Columns.count).End(xlToLeft).Column

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
Sub КОПИР()
 Dim a&, f&, w&, t&, e&, k&, l&, g&, v&, x&, d&
  Application.ScreenUpdating = False
 Dim ta: ta = Timer
 a = 152
 l = 1
 v = 1
 g = 1
 x = 31
 For w = 1 To 64
For e = 1 To 128
For t = 1 To 7
k = k + 1
d = Cells(a + k, Columns.count).End(xlToLeft).Column
Range(Cells(a, l + 4), Cells(a, x)).Copy Cells(a + k, d + f)
d = Cells(a + k, Columns.count).End(xlToLeft).Column
Range(Cells(a, g), Cells(a, v + 2)).Copy Cells(a + k, d + 2)
l = l + 4
v = v + 4
Next t
f = 2
l = l + 4
v = v + 4
g = g + 32
x = x + 32
k = 0
Next e
f = 0
l = 1
v = 1
g = 1
x = 31
b = 1
a = a + 21
Next w
MsgBox Timer - ta
Application.ScreenUpdating = True
End Sub
0
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
10.03.2013, 17:13
Ответы с готовыми решениями:

Нужен очень простой и очень содержательный мануал по взаимодействию приложений, написанных на VB 6.0
Добрый день всем, очень нужен очень простой в понимании и очень содержательный...

Excel. Копирование столбца, при заполнении 22-й строки продолжить копирование в соседний столбец
Всем привет. Задача: Есть таблица Excel, заполнены 2 столбца, из них первый -...

Очень медленное копирование файлов, разархивирование..
Всем привет! У меня проблема со скоростью копирования файлов, папок, архивов,...

Медленное копирование на HDD
Здравствуйте В один (600мб) из двух разделов HDD WD1 тб "красный" стали...

Очень медленное отображение bmp
В базе Postgresql хранятся черно-белые bmp-картинки (pf1bit) Размер картинок...

5
toiai
3101 / 891 / 196
Регистрация: 29.05.2010
Сообщений: 1,922
10.03.2013, 17:28 2
Файл-пример приложите и поясните что необходимо сделать, а то в коде сложно разбираться без понимания.
0
Igor_Tr
4369 / 653 / 36
Регистрация: 17.01.2010
Сообщений: 2,134
10.03.2013, 18:49 3
To Caша(Я). Обратите внимание на это:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
 Dim ta: ta = Timer
 a = 152
 l = 1
 v = 1
 g = 1
 x = 31
 For w = 1 To 64
   For e = 1 To 128
      For t = 1 To 7
         k = k + 1
        d = Cells(a + k, Columns.count).End(xlToLeft).Column
Хотя Вы и обявили переменную "k&", но судьба ее от начала и до сюда не известна, а роль - очень даже важная.
0
toiai
3101 / 891 / 196
Регистрация: 29.05.2010
Сообщений: 1,922
10.03.2013, 18:55 4
Если не объявлена, то k=0
0
Igor_Tr
4369 / 653 / 36
Регистрация: 17.01.2010
Сообщений: 2,134
10.03.2013, 19:47 5
Да не проблема. Я просто спрашиваю. А дублеж строки 14 и 16? Он обязателен?
d = Cells(a + k, Columns.Count).End(xlToLeft).Column
Добавлено через 6 минут
И еще. Я не могу найти, где обявлена переменная "b" (см. стр. 33). Или ее просто помят?

Добавлено через 26 минут
У меня 2003, поэтому для эксперимента, немного изменил цикл For t = .... next (и выключил переменную "b") :
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
For t = 1 To 7
   k = k + 1
   d = Cells(a + k, Columns.Count).End(xlToLeft).Column
      If l > 253 Then
         MsgBox "Limit exceeded. " & "Time: - " & (Timer - ta)
         Exit Sub
      End If
   Range(Cells(a, l + 4), Cells(a, x)).Copy Cells(a + k, d + f)
   ' d = Cells(a + k, Columns.Count).End(xlToLeft).Column
   Range(Cells(a, g), Cells(a, v + 2)).Copy Cells(a + k, d + 2)
   l = l + 4
   v = v + 4
Next t
Время - 0.3 сек. Вобще, не плохо. Может причина в другом?

Добавлено через 12 минут
To Caша(Я). На всяки случай. А не обявлена у Вас где-то "k" как глобальная? Проще всего проверить через Lokal (Watch), или поставьте
Msgbox k
после
Dim ta: ta = Timer
0
Саша(Я)
0 / 0 / 0
Регистрация: 01.03.2011
Сообщений: 5
11.03.2013, 00:00  [ТС] 6
Спасибо всем за помощь,я понимаю сложно понять,если нет примера.Igor_Tr ваша часть ничего к сожелению у меня не копирует ,но работает быстро.А эти две строки очень важны в том макросе,их убирать нельзя: d = Cells(a + k, Columns.count).End(xlToLeft).Column.Сам слепил макрос ,какой мне нужен отрабатывает за 20 секунд, для меня очень не плохо,по сравнению со старым моим макросом,который это делал 325 секунд.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Sub КОПИР()
Dim i&, a&, d&, k&, arr()
 Dim ta: ta = Timer
arr = [a152:fam1482].Value: k = 1
For i = LBound(arr, 1) To UBound(arr, 1)
d = d + 1
For a = LBound(arr, 2) To UBound(arr, 2) Step 32
arr(i + k, a) = arr(i, a + 4)
arr(i + k, a + 1) = arr(i, a + 5)
arr(i + k, a + 2) = arr(i, a + 6)
arr(i + k, a + 4) = arr(i, a + 8)
arr(i + k, a + 5) = arr(i, a + 9)
arr(i + k, a + 6) = arr(i, a + 10)
arr(i + k, a + 8) = arr(i, a + 12)
arr(i + k, a + 9) = arr(i, a + 13)
arr(i + k, a + 10) = arr(i, a + 14)
arr(i + k, a + 12) = arr(i, a + 16)
arr(i + k, a + 13) = arr(i, a + 17)
arr(i + k, a + 14) = arr(i, a + 18)
arr(i + k, a + 16) = arr(i, a + 20)
arr(i + k, a + 17) = arr(i, a + 21)
arr(i + k, a + 18) = arr(i, a + 22)
arr(i + k, a + 20) = arr(i, a + 24)
arr(i + k, a + 21) = arr(i, a + 25)
arr(i + k, a + 22) = arr(i, a + 26)
arr(i + k, a + 24) = arr(i, a + 28)
arr(i + k, a + 25) = arr(i, a + 29)
arr(i + k, a + 26) = arr(i, a + 30)
arr(i + k, a + 28) = arr(i, a)
arr(i + k, a + 29) = arr(i, a + 1)
arr(i + k, a + 30) = arr(i, a + 2)
Next a
If d = 7 Then i = i + 14: d = 0
Next i
[a152:fam1482].Value = arr
MsgBox Timer - ta
End Sub
0
11.03.2013, 00:00
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
11.03.2013, 00:00

Медленное копирование файлов на флешки и ж.д
Здравствуйте! Может кто сталкивался? На windows8 при копировании любых файлов...

Медленное копирование с HDD на флеш
Купили в офис новый диск Western Digital WD2003FZEX Caviar Black, SATA III . ...

Критично медленное копирование с HDD
некоторые файлы копируются со скоростью в 500 байт на сек. проверял...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
6
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru