Организация цикла (оптимизировать код)

[diop]

Здраствуйте.

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

'1
     [G9:J36].Value = GetObject(f).Worksheets(1).[G9:J36].Value
     [G38:J41].Value = GetObject(f).Worksheets(1).[G38:J41].Value
     [G45:J67].Value = GetObject(f).Worksheets(1).[G45:J67].Value
     [G71:J110].Value = GetObject(f).Worksheets(1).[G71:J110].Value
'2
     [L9:O36].Value = GetObject(f).Worksheets(1).[L9:O36].Value
     [L38:O41].Value = GetObject(f).Worksheets(1).[L38:O41].Value
     [L45:O67].Value = GetObject(f).Worksheets(1).[L45:O67].Value
     [L71:O110].Value = GetObject(f).Worksheets(1).[L71:O110].Value
'3
     [Q9:T36].Value = GetObject(f).Worksheets(1).[Q9:T36].Value
     [Q38:T41].Value = GetObject(f).Worksheets(1).[Q38:T41].Value
     [Q45:T67].Value = GetObject(f).Worksheets(1).[Q45:T67].Value
     [Q71:T110].Value = GetObject(f).Worksheets(1).[Q71:T110].Value
'4
     [V9:Y36].Value = GetObject(f).Worksheets(1).[V9:Y36].Value
     [V38:Y41].Value = GetObject(f).Worksheets(1).[V38:Y41].Value
     [V45:Y67].Value = GetObject(f).Worksheets(1).[V45:Y67].Value
     [V71:Y110].Value = GetObject(f).Worksheets(1).[V71:Y110].Value
'5
     [AA9:AD36].Value = GetObject(f).Worksheets(1).[AA9:AD36].Value
     [AA38:AD41].Value = GetObject(f).Worksheets(1).[AA38:AD41].Value
     [AA45:AD67].Value = GetObject(f).Worksheets(1).[AA45:AD67].Value
     [AA71:AD110].Value = GetObject(f).Worksheets(1).[AA71:AD110].Value
'6
     [AF9:AI36].Value = GetObject(f).Worksheets(1).[AF9:AI36].Value
     [AF38:AI41].Value = GetObject(f).Worksheets(1).[AF38:AI41].Value
     [AF45:AI67].Value = GetObject(f).Worksheets(1).[AF45:AI67].Value
     [AF71:AI110].Value = GetObject(f).Worksheets(1).[AF71:AI110].Value
'7
     [AK9:AN36].Value = GetObject(f).Worksheets(1).[AK9:AN36].Value
     [AK38:AN41].Value = GetObject(f).Worksheets(1).[AK38:AN41].Value
     [AK45:AN67].Value = GetObject(f).Worksheets(1).[AK45:AN67].Value
     [AK71:AN110].Value = GetObject(f).Worksheets(1).[AK71:AN110].Value
'8
     [AP9:AS36].Value = GetObject(f).Worksheets(1).[AP9:AS36].Value
     [AP38:AS41].Value = GetObject(f).Worksheets(1).[AP38:AS41].Value
     [AP45:AS67].Value = GetObject(f).Worksheets(1).[AP45:AS67].Value
     [AP71:AS110].Value = GetObject(f).Worksheets(1).[AP71:AS110].Value
'9
     [AU9:AX36].Value = GetObject(f).Worksheets(1).[AU9:AX36].Value
     [AU38:AX41].Value = GetObject(f).Worksheets(1).[AU38:AX41].Value
     [AU45:AX67].Value = GetObject(f).Worksheets(1).[AU45:AX67].Value
     [AU71:AX110].Value = GetObject(f).Worksheets(1).[AU71:AX110].Value

[Казанский]

В каждой группе 1-9 копируется диапазон из 4 столбцов, за исключением строк 37, 42-44, 68-70. На текущем листе в них что-то есть, что нельзя затирать?
Аналогично со столбцами K, P, ...
Было бы проще и быстрее скопировать один большой диапазон, а потом очистить упомянутые строки и столбцы.

[diop]

Сообщение от Казанский

В каждой группе 1-9 копируется диапазон из 4 столбцов, за исключением строк 37, 42-44, 68-70. На текущем листе в них что-то есть, что нельзя затирать?
Аналогично со столбцами K, P, ...
Было бы проще и быстрее скопировать один большой диапазон, а потом очистить упомянутые строки и столбцы.

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

[Казанский]

Тогда так

Dim i As Long
With GetObject(f).Worksheets(1)
  For i = 0 To 40 Step 5
    [G9:J36].Offset(, i).Value = .[G9:J36].Offset(, i).Value
    [G38:J41].Offset(, i).Value = .[G38:J41].Offset(, i).Value
    [G45:J67].Offset(, i).Value = .[G45:J67].Offset(, i).Value
    [G71:J110].Offset(, i).Value = .[G71:J110].Offset(, i).Value
  Next
End With

[Hugo121]

Вариант:

    Dim r1 As Range, r2 As Range, r3 As Range, r4 As Range, sh As Worksheet, i&

    Set r1 = [G9:J36]
    Set r2 = [G38:J41]
    Set r3 = [G45:J67]
    Set r4 = [G71:J110]

    Set sh = GetObject(f).Worksheets(1)

    For i = 1 To 9
        r1.Value = sh.Range(r1.Address).Value
        r2.Value = sh.Range(r2.Address).Value
        r3.Value = sh.Range(r3.Address).Value
        r4.Value = sh.Range(r4.Address).Value
        Set r1 = r1.Offset(, 5)
        Set r2 = r2.Offset(, 5)
        Set r3 = r3.Offset(, 5)
        Set r4 = r4.Offset(, 5)
    Next

    sh.Parent.Close 0    'если нужно

[IgorGO]

Sub GetSameCells()
  Dim n As Long
  For n = 1 To 9
    Cells(9, 2 + 5 * n).Resize(28, 4).Value = GetObject(f).Worksheets(1).Cells(9, 2 + 5 * n).Resize(28, 4).Value
    Cells(38, 2 + 5 * n).Resize(4, 4).Value = GetObject(f).Worksheets(1).Cells(38, 2 + 5 * n).Resize(4, 4).Value
    Cells(46, 2 + 5 * n).Resize(22, 4).Value = GetObject(f).Worksheets(1).Cells(46, 2 + 5 * n).Resize(22, 4).Value
    Cells(71, 2 + 5 * n).Resize(40, 4).Value = GetObject(f).Worksheets(1).Cells(71, 2 + 5 * n).Resize(40, 4).Value
  Next
End Sub

[diop]

Сообщение от IgorGO

Sub GetSameCells()
  Dim n As Long
  For n = 1 To 9
    Cells(9, 2 + 5 * n).Resize(28, 4).Value = GetObject(f).Worksheets(1).Cells(9, 2 + 5 * n).Resize(28, 4).Value
    Cells(38, 2 + 5 * n).Resize(4, 4).Value = GetObject(f).Worksheets(1).Cells(38, 2 + 5 * n).Resize(4, 4).Value
    Cells(46, 2 + 5 * n).Resize(22, 4).Value = GetObject(f).Worksheets(1).Cells(46, 2 + 5 * n).Resize(22, 4).Value
    Cells(71, 2 + 5 * n).Resize(40, 4).Value = GetObject(f).Worksheets(1).Cells(71, 2 + 5 * n).Resize(40, 4).Value
  Next
End Sub

большое спасиба. отличное решение задачи.

[Hugo121]

Мне больше нравится с одним GetObject(f), а не с 36.
Хотя есть ли практическая разница - точно не знаю, но кажется что должна быть...

[slan]

сначала желательно решить - вам цикл нужен или код оптимизировать?

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

[IgorGO]

или так:

Sub GetSameCells()
  Dim i As Long, j As Long, s, ard As String
  s = Split("9 38 46 71 28 4 22 40")
  With GetObject(f).Worksheets(1)
    For i = 1 To 9
      For j = 0 To 3
        adr = Cells(s(j), 2 + 5 * i).Resize(s(4 + j), 4).Address:   Range(adr).Value = .Range(adr).Value
      Next
    Next
  End With
End Sub

уйдем от прозрачно понятного кода в сторону арифметических абстакций