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

[Андрей5]

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

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

[staniiislav]

Сообщение от Андрей5

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

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

пример то чего вы копируете в экселевском файле скиньте, сделаем на массивах!

[Андрей5]

Спасибо за помощь сам слепил себе макрос ,старый работал 325 секунд,а это работает 20 секунд,для меня очень не плохо.

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