Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Динамический цикл - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Динамический цикл
Кузьмич Дата: Пятница, 27.09.2024, 09:36 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 77
Репутация: 2 ±
Замечаний: 0% ±

Excel 2013
[b]Всем доброго здравия![b]
Решая свою задачу и доводя до автоматизма, мне пришлось применить макрос с теми действиями которые требуются для реализации решения. Применил к макросу кнопку, при нажатии которой все требуемые действия выполняются корректно. Дело в том, что хотел сделать это все в цикл и указать в ячейке сколько таких действий требуется, чтоб не нажимать кнопку более 1к раз, слишком утомительное занятие. Сам я не программист и поэтому прошу знающих, внедрить цикл к моему макросу. Благодарю за понимание! Код макроса прилагается ниже...
[vba]
Код
Sub ЦИКЛ()
'
' ЦИКЛ Макрос
'

'
Range("P4:Q4").Select
Selection.ClearContents
Range("A4:O4").Select
Selection.Copy
Range("A1:O1").Select
ActiveSheet.Paste
Range("A1732").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Calculate
Range("R1:AM1").Select
Selection.Copy
Range("R1732").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("P1731:Q1731").Select
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("P1731:Q1732"), Type:=xlFillDefault
Range("P1731:Q1732").Select
Rows("4:4").Select
Selection.Delete Shift:=xlUp
Range("A2").Select
ActiveSheet.Calculate
End Sub
[/vba]


Ну, теперь вся утка наша...

Сообщение отредактировал Кузьмич - Пятница, 27.09.2024, 15:53
 
Ответить
Сообщение[b]Всем доброго здравия![b]
Решая свою задачу и доводя до автоматизма, мне пришлось применить макрос с теми действиями которые требуются для реализации решения. Применил к макросу кнопку, при нажатии которой все требуемые действия выполняются корректно. Дело в том, что хотел сделать это все в цикл и указать в ячейке сколько таких действий требуется, чтоб не нажимать кнопку более 1к раз, слишком утомительное занятие. Сам я не программист и поэтому прошу знающих, внедрить цикл к моему макросу. Благодарю за понимание! Код макроса прилагается ниже...
[vba]
Код
Sub ЦИКЛ()
'
' ЦИКЛ Макрос
'

'
Range("P4:Q4").Select
Selection.ClearContents
Range("A4:O4").Select
Selection.Copy
Range("A1:O1").Select
ActiveSheet.Paste
Range("A1732").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Calculate
Range("R1:AM1").Select
Selection.Copy
Range("R1732").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("P1731:Q1731").Select
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("P1731:Q1732"), Type:=xlFillDefault
Range("P1731:Q1732").Select
Rows("4:4").Select
Selection.Delete Shift:=xlUp
Range("A2").Select
ActiveSheet.Calculate
End Sub
[/vba]

Автор - Кузьмич
Дата добавления - 27.09.2024 в 09:36
Апострофф Дата: Пятница, 27.09.2024, 09:58 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 457
Репутация: 126 ±
Замечаний: 0% ±

Excel 1997
Кузьмич, может быть подредактируете свой пост?
Лучше совсем без тегов, чем такое!
 
Ответить
СообщениеКузьмич, может быть подредактируете свой пост?
Лучше совсем без тегов, чем такое!

Автор - Апострофф
Дата добавления - 27.09.2024 в 09:58
Hugo Дата: Пятница, 27.09.2024, 11:43 | Сообщение № 3
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3595
Репутация: 779 ±
Замечаний: 0% ±

365
Кузьмич, уберите из кода все ActiveWindow.ScrollRow - будет проще понять что вообще хотите. Хотя вряд ли... ((


webmoney: E265281470651 Z422237915069
USDT TRC20: TN8XeEF17o5KPBD9pNwYzNyruycuAc2mVD
 
Ответить
СообщениеКузьмич, уберите из кода все ActiveWindow.ScrollRow - будет проще понять что вообще хотите. Хотя вряд ли... ((

Автор - Hugo
Дата добавления - 27.09.2024 в 11:43
Кузьмич Дата: Пятница, 27.09.2024, 15:47 | Сообщение № 4
Группа: Пользователи
Ранг: Участник
Сообщений: 77
Репутация: 2 ±
Замечаний: 0% ±

Excel 2013
Вот так?
[vba]
Код
Sub ЦИКЛ()
'
' ЦИКЛ Макрос
'

'
Range("P4:Q4").Select
Selection.ClearContents
Range("A4:O4").Select
Selection.Copy
Range("A1:O1").Select
ActiveSheet.Paste
Range("A1732").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Calculate
Range("R1:AM1").Select
Selection.Copy
Range("R1732").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("P1731:Q1731").Select
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("P1731:Q1732"), Type:=xlFillDefault
Range("P1731:Q1732").Select
Rows("4:4").Select
Selection.Delete Shift:=xlUp
Range("A2").Select
ActiveSheet.Calculate
End Sub
[/vba]


Ну, теперь вся утка наша...
 
Ответить
СообщениеВот так?
[vba]
Код
Sub ЦИКЛ()
'
' ЦИКЛ Макрос
'

'
Range("P4:Q4").Select
Selection.ClearContents
Range("A4:O4").Select
Selection.Copy
Range("A1:O1").Select
ActiveSheet.Paste
Range("A1732").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Calculate
Range("R1:AM1").Select
Selection.Copy
Range("R1732").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("P1731:Q1731").Select
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("P1731:Q1732"), Type:=xlFillDefault
Range("P1731:Q1732").Select
Rows("4:4").Select
Selection.Delete Shift:=xlUp
Range("A2").Select
ActiveSheet.Calculate
End Sub
[/vba]

Автор - Кузьмич
Дата добавления - 27.09.2024 в 15:47
Hugo Дата: Пятница, 27.09.2024, 17:04 | Сообщение № 5
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3595
Репутация: 779 ±
Замечаний: 0% ±

365
Ну если судить по коду - тут цикл не нужен, можно только лишнее повыкидывать.
Но если знать задачу - можно например в цикле менять 4 до 1004, но задачу с файлом никто тут не видел.


webmoney: E265281470651 Z422237915069
USDT TRC20: TN8XeEF17o5KPBD9pNwYzNyruycuAc2mVD
 
Ответить
СообщениеНу если судить по коду - тут цикл не нужен, можно только лишнее повыкидывать.
Но если знать задачу - можно например в цикле менять 4 до 1004, но задачу с файлом никто тут не видел.

Автор - Hugo
Дата добавления - 27.09.2024 в 17:04
Pelena Дата: Пятница, 27.09.2024, 17:12 | Сообщение № 6
Группа: Админы
Ранг: Местный житель
Сообщений: 19373
Репутация: 4531 ±
Замечаний: ±

Excel 365 & Mac Excel
Кузьмич, оформите код тегами с помощью кнопки # в режиме правки поста.
Первый пост исправила за Вас, дальше уже сами


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеКузьмич, оформите код тегами с помощью кнопки # в режиме правки поста.
Первый пост исправила за Вас, дальше уже сами

Автор - Pelena
Дата добавления - 27.09.2024 в 17:12
Кузьмич Дата: Воскресенье, 29.09.2024, 18:11 | Сообщение № 7
Группа: Пользователи
Ранг: Участник
Сообщений: 77
Репутация: 2 ±
Замечаний: 0% ±

Excel 2013
[vba]
Код
Sub ЦИКЛ()
'
' ЦИКЛ Макрос
'

'
Range("P4:Q4").Select
Selection.ClearContents
Range("A4:O4").Select
Selection.Copy
Range("A1:O1").Select
ActiveSheet.Paste
Range("A1732").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Calculate
Range("R1:AM1").Select
Selection.Copy
Range("R1732").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("P1731:Q1731").Select
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("P1731:Q1732"), Type:=xlFillDefault
Range("P1731:Q1732").Select
Rows("4:4").Select
Selection.Delete Shift:=xlUp
Range("A2").Select
ActiveSheet.Calculate
End Sub
[/vba]


Ну, теперь вся утка наша...

Сообщение отредактировал Кузьмич - Воскресенье, 29.09.2024, 18:16
 
Ответить
Сообщение[vba]
Код
Sub ЦИКЛ()
'
' ЦИКЛ Макрос
'

'
Range("P4:Q4").Select
Selection.ClearContents
Range("A4:O4").Select
Selection.Copy
Range("A1:O1").Select
ActiveSheet.Paste
Range("A1732").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Calculate
Range("R1:AM1").Select
Selection.Copy
Range("R1732").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("P1731:Q1731").Select
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("P1731:Q1732"), Type:=xlFillDefault
Range("P1731:Q1732").Select
Rows("4:4").Select
Selection.Delete Shift:=xlUp
Range("A2").Select
ActiveSheet.Calculate
End Sub
[/vba]

Автор - Кузьмич
Дата добавления - 29.09.2024 в 18:11
MikeVol Дата: Понедельник, 30.09.2024, 08:32 | Сообщение № 8
Группа: Проверенные
Ранг: Обитатель
Сообщений: 358
Репутация: 68 ±
Замечаний: 0% ±

Excel LTSC 2021 EN
Кузьмич, Доброго времени суток.
Цитата Кузьмич, 27.09.2024 в 09:36, в сообщении № 1 ()
чтоб не нажимать кнопку более 1к раз
[vba]
Код
Option Explicit

Sub ЦИКЛ()
    Dim i           As Long
    Dim numIterations As Long
    numIterations = Sheet2.Range("B1").Value   ' Ваша ячейка которая спасёт ваши пальцы, меняете если пожелаете
    Application.ScreenUpdating = False

    For i = 1 To numIterations
        Range("P4:Q4").ClearContents
        Range("A4:O4").Copy
        Range("A1:O1").PasteSpecial Paste:=xlPasteAll
        Range("A1732").PasteSpecial Paste:=xlPasteAll
        Application.CutCopyMode = False
        ActiveSheet.Calculate

        Range("R1:AM1").Copy
        Range("R1732").PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False

        Range("P1731:Q1731").AutoFill Destination:=Range("P1731:Q1732"), Type:=xlFillDefault
        Rows("4:4").Delete Shift:=xlUp
        ActiveSheet.Calculate
    Next i

    Application.ScreenUpdating = True
End Sub
[/vba] Sheet2.Range("B1").Value это и есть ваша
Цитата Кузьмич, 27.09.2024 в 09:36, в сообщении № 1 ()
указать в ячейке
Надеюсь я вас правильно понял. Удачи.


Ученик.
 
Ответить
СообщениеКузьмич, Доброго времени суток.
Цитата Кузьмич, 27.09.2024 в 09:36, в сообщении № 1 ()
чтоб не нажимать кнопку более 1к раз
[vba]
Код
Option Explicit

Sub ЦИКЛ()
    Dim i           As Long
    Dim numIterations As Long
    numIterations = Sheet2.Range("B1").Value   ' Ваша ячейка которая спасёт ваши пальцы, меняете если пожелаете
    Application.ScreenUpdating = False

    For i = 1 To numIterations
        Range("P4:Q4").ClearContents
        Range("A4:O4").Copy
        Range("A1:O1").PasteSpecial Paste:=xlPasteAll
        Range("A1732").PasteSpecial Paste:=xlPasteAll
        Application.CutCopyMode = False
        ActiveSheet.Calculate

        Range("R1:AM1").Copy
        Range("R1732").PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False

        Range("P1731:Q1731").AutoFill Destination:=Range("P1731:Q1732"), Type:=xlFillDefault
        Rows("4:4").Delete Shift:=xlUp
        ActiveSheet.Calculate
    Next i

    Application.ScreenUpdating = True
End Sub
[/vba] Sheet2.Range("B1").Value это и есть ваша
Цитата Кузьмич, 27.09.2024 в 09:36, в сообщении № 1 ()
указать в ячейке
Надеюсь я вас правильно понял. Удачи.

Автор - MikeVol
Дата добавления - 30.09.2024 в 08:32
Кузьмич Дата: Понедельник, 30.09.2024, 08:39 | Сообщение № 9
Группа: Пользователи
Ранг: Участник
Сообщений: 77
Репутация: 2 ±
Замечаний: 0% ±

Excel 2013
Pelena, отредактировал по запросу. Вопрос в том, что данный код - это и есть один целый оборот цикла, но каждый раз жать на кнопку и более 1к раз - это утомительное занятие. Допустим данный цикл нужно запустить 1500 раз или 6000 раз, как мне это осуществить? Что требуется добавить до кода и после, чтоб он автоматом крутил требуемое количество раз (счетчик и код цикла по счетчику)? Благодарю за понимание!


Ну, теперь вся утка наша...
 
Ответить
СообщениеPelena, отредактировал по запросу. Вопрос в том, что данный код - это и есть один целый оборот цикла, но каждый раз жать на кнопку и более 1к раз - это утомительное занятие. Допустим данный цикл нужно запустить 1500 раз или 6000 раз, как мне это осуществить? Что требуется добавить до кода и после, чтоб он автоматом крутил требуемое количество раз (счетчик и код цикла по счетчику)? Благодарю за понимание!

Автор - Кузьмич
Дата добавления - 30.09.2024 в 08:39
Кузьмич Дата: Понедельник, 30.09.2024, 08:56 | Сообщение № 10
Группа: Пользователи
Ранг: Участник
Сообщений: 77
Репутация: 2 ±
Замечаний: 0% ±

Excel 2013
Range("R1:AM1").Copy
        Range("R1732").PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False

Вот эта цифра 1732 - это конечная по завершению цикла. Данная цифра может меняться. Если я правильно понял, то "B1" в которой задается количество циклов - должно совпадать с нижней вставкой.
Допустим у меня табла 2000 строк. В ячейке "B1" задаю цикл в 2000 раз, тогда и копировать результат она должна на "R2000" в самый низ, т.к четвертая строка в конце каждого оборота удаляется, т.е происходит сдвиг на строку выше, чтоб следующий оборот снова заполнил данные в "R2000". А до него данные автоматом сдвигаются вверх и они уже 1999.


Ну, теперь вся утка наша...
 
Ответить
Сообщение
Range("R1:AM1").Copy
        Range("R1732").PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False

Вот эта цифра 1732 - это конечная по завершению цикла. Данная цифра может меняться. Если я правильно понял, то "B1" в которой задается количество циклов - должно совпадать с нижней вставкой.
Допустим у меня табла 2000 строк. В ячейке "B1" задаю цикл в 2000 раз, тогда и копировать результат она должна на "R2000" в самый низ, т.к четвертая строка в конце каждого оборота удаляется, т.е происходит сдвиг на строку выше, чтоб следующий оборот снова заполнил данные в "R2000". А до него данные автоматом сдвигаются вверх и они уже 1999.

Автор - Кузьмич
Дата добавления - 30.09.2024 в 08:56
MikeVol Дата: Понедельник, 30.09.2024, 09:01 | Сообщение № 11
Группа: Проверенные
Ранг: Обитатель
Сообщений: 358
Репутация: 68 ±
Замечаний: 0% ±

Excel LTSC 2021 EN
Кузьмич, Можете файл пример приложить для отладки кода?


Ученик.
 
Ответить
СообщениеКузьмич, Можете файл пример приложить для отладки кода?

Автор - MikeVol
Дата добавления - 30.09.2024 в 09:01
Кузьмич Дата: Понедельник, 30.09.2024, 10:40 | Сообщение № 12
Группа: Пользователи
Ранг: Участник
Сообщений: 77
Репутация: 2 ±
Замечаний: 0% ±

Excel 2013
MikeVol,
К сообщению приложен файл: test.xlsm (292.0 Kb)


Ну, теперь вся утка наша...
 
Ответить
СообщениеMikeVol,

Автор - Кузьмич
Дата добавления - 30.09.2024 в 10:40
Hugo Дата: Понедельник, 30.09.2024, 11:08 | Сообщение № 13
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3595
Репутация: 779 ±
Замечаний: 0% ±

365
Цитата Кузьмич, 30.09.2024 в 08:39, в сообщении № 9 ()
данный цикл нужно запустить 1500 раз или 6000 раз

[vba]
Код

sub skokoraz()
dim i&
for i=1 to skokonado
call ЦИКЛ
next
end sub
[/vba]
Этот макрос разместить рядом и запустить, вместо skokonado указать число, можно его брать из ячейки.


webmoney: E265281470651 Z422237915069
USDT TRC20: TN8XeEF17o5KPBD9pNwYzNyruycuAc2mVD


Сообщение отредактировал Hugo - Понедельник, 30.09.2024, 11:09
 
Ответить
Сообщение
Цитата Кузьмич, 30.09.2024 в 08:39, в сообщении № 9 ()
данный цикл нужно запустить 1500 раз или 6000 раз

[vba]
Код

sub skokoraz()
dim i&
for i=1 to skokonado
call ЦИКЛ
next
end sub
[/vba]
Этот макрос разместить рядом и запустить, вместо skokonado указать число, можно его брать из ячейки.

Автор - Hugo
Дата добавления - 30.09.2024 в 11:08
Кузьмич Дата: Понедельник, 30.09.2024, 14:55 | Сообщение № 14
Группа: Пользователи
Ранг: Участник
Сообщений: 77
Репутация: 2 ±
Замечаний: 0% ±

Excel 2013
Hugo, благодарю за предложение, но я далёк от программирования и мне не понятно куда его внедрить в свой макрос. Ведь там должен быть правильно выставлен алгоритм действий.


Ну, теперь вся утка наша...
 
Ответить
СообщениеHugo, благодарю за предложение, но я далёк от программирования и мне не понятно куда его внедрить в свой макрос. Ведь там должен быть правильно выставлен алгоритм действий.

Автор - Кузьмич
Дата добавления - 30.09.2024 в 14:55
MikeVol Дата: Вторник, 01.10.2024, 08:44 | Сообщение № 15
Группа: Проверенные
Ранг: Обитатель
Сообщений: 358
Репутация: 68 ±
Замечаний: 0% ±

Excel LTSC 2021 EN
Цитата Кузьмич, 30.09.2024 в 14:55, в сообщении № 14 ()
мне не понятно куда его внедрить в свой макрос

Смотрите файл.
К сообщению приложен файл: 01_10_2024_exw_dinamicheskij_c.xlsm (291.7 Kb)


Ученик.
 
Ответить
Сообщение
Цитата Кузьмич, 30.09.2024 в 14:55, в сообщении № 14 ()
мне не понятно куда его внедрить в свой макрос

Смотрите файл.

Автор - MikeVol
Дата добавления - 01.10.2024 в 08:44
Hugo Дата: Вторник, 01.10.2024, 08:54 | Сообщение № 16
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3595
Репутация: 779 ±
Замечаний: 0% ±

365
Кузьмич, ну я ведь всё написал, читайте и понимайте буквально каждое слово ))
В программировании так - каждое слово имеет значение ))


webmoney: E265281470651 Z422237915069
USDT TRC20: TN8XeEF17o5KPBD9pNwYzNyruycuAc2mVD
 
Ответить
СообщениеКузьмич, ну я ведь всё написал, читайте и понимайте буквально каждое слово ))
В программировании так - каждое слово имеет значение ))

Автор - Hugo
Дата добавления - 01.10.2024 в 08:54
Кузьмич Дата: Вторник, 01.10.2024, 09:22 | Сообщение № 17
Группа: Пользователи
Ранг: Участник
Сообщений: 77
Репутация: 2 ±
Замечаний: 0% ±

Excel 2013
Смотрите файл.

[vba]
Код
Sub Цикл2()
'
' Цикл2 Макрос
'

'
    Range("A4:O4").Select
    Selection.Copy
    Range("A1:O1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.Calculate
    Range("R1:AM1").Select
    Selection.Copy
    Range("R4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A5:O5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("A1:O1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.Calculate
    Range("R1:AM1").Select
    Selection.Copy
    Range("R5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A6:O6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("A1:O1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.Calculate
    Range("R1:AM1").Select
    Selection.Copy
    Range("R6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A7:O7").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("A1:O1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.Calculate
    Range("R1:AM1").Select
    Selection.Copy
    Range("R7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub
[/vba]
И т.д до конца таблицы. А таблица динамическая, т.к она может быть с разным количеством строк.
Может этот алгоритм более понятен. Т.е берем строку с таблицы и вставляем её в самый верх для обработки, далее, полученный результат копируем и вставляем рядом с той строкой таблицы, которую обрабатывали. Далее следующую строку из таблицы копируем вверх и обработку копируем рядом, и т.д вниз по таблице.
Этот вариант без удаления строки.
Ваш код я посмотрел - он хорош, но конечная строка у него 1732, а сток может быть меньше в таблице или больше. Благодарю за понимание.


Ну, теперь вся утка наша...
 
Ответить
Сообщение
Смотрите файл.

[vba]
Код
Sub Цикл2()
'
' Цикл2 Макрос
'

'
    Range("A4:O4").Select
    Selection.Copy
    Range("A1:O1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.Calculate
    Range("R1:AM1").Select
    Selection.Copy
    Range("R4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A5:O5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("A1:O1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.Calculate
    Range("R1:AM1").Select
    Selection.Copy
    Range("R5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A6:O6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("A1:O1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.Calculate
    Range("R1:AM1").Select
    Selection.Copy
    Range("R6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A7:O7").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("A1:O1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.Calculate
    Range("R1:AM1").Select
    Selection.Copy
    Range("R7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub
[/vba]
И т.д до конца таблицы. А таблица динамическая, т.к она может быть с разным количеством строк.
Может этот алгоритм более понятен. Т.е берем строку с таблицы и вставляем её в самый верх для обработки, далее, полученный результат копируем и вставляем рядом с той строкой таблицы, которую обрабатывали. Далее следующую строку из таблицы копируем вверх и обработку копируем рядом, и т.д вниз по таблице.
Этот вариант без удаления строки.
Ваш код я посмотрел - он хорош, но конечная строка у него 1732, а сток может быть меньше в таблице или больше. Благодарю за понимание.

Автор - Кузьмич
Дата добавления - 01.10.2024 в 09:22
MikeVol Дата: Вторник, 01.10.2024, 10:00 | Сообщение № 18
Группа: Проверенные
Ранг: Обитатель
Сообщений: 358
Репутация: 68 ±
Замечаний: 0% ±

Excel LTSC 2021 EN
Не-а, я пас. Что-то я в ступор зашёл. Извините.


Ученик.
 
Ответить
СообщениеНе-а, я пас. Что-то я в ступор зашёл. Извините.

Автор - MikeVol
Дата добавления - 01.10.2024 в 10:00
Nic70y Дата: Вторник, 01.10.2024, 10:07 | Сообщение № 19
Группа: Друзья
Ранг: Экселист
Сообщений: 8972
Репутация: 2356 ±
Замечаний: 0% ±

Excel 2010
[vba]
Код
Sub u_421()
    a = Cells(Rows.Count, "a").End(xlUp).Row 'нижняя строка таблицы
    For b = 4 To a 'цикл от 4 до нижней строки таблицы
        Range("a" & b & ":o" & b).Copy Range("a1") 'копируем очередную строку [A:O] - вставляем в 1ю
        Range("r" & b & ":am" & b) = Range("r1:am1").Value 'очередную строку [R:AM] = значению 1й
    Next
End Sub
[/vba]


ЮMoney 41001841029809

Сообщение отредактировал Nic70y - Вторник, 01.10.2024, 10:08
 
Ответить
Сообщение[vba]
Код
Sub u_421()
    a = Cells(Rows.Count, "a").End(xlUp).Row 'нижняя строка таблицы
    For b = 4 To a 'цикл от 4 до нижней строки таблицы
        Range("a" & b & ":o" & b).Copy Range("a1") 'копируем очередную строку [A:O] - вставляем в 1ю
        Range("r" & b & ":am" & b) = Range("r1:am1").Value 'очередную строку [R:AM] = значению 1й
    Next
End Sub
[/vba]

Автор - Nic70y
Дата добавления - 01.10.2024 в 10:07
Кузьмич Дата: Вторник, 01.10.2024, 10:48 | Сообщение № 20
Группа: Пользователи
Ранг: Участник
Сообщений: 77
Репутация: 2 ±
Замечаний: 0% ±

Excel 2013
Nic70y, Благодарю от души тебя! Всё сработало как нужно!
MikeVol, И тебе благодарность за помощь!
Всем здравия, хорошего дня и отличного настроения!!! СПАСИБО
:up:


Ну, теперь вся утка наша...
 
Ответить
СообщениеNic70y, Благодарю от души тебя! Всё сработало как нужно!
MikeVol, И тебе благодарность за помощь!
Всем здравия, хорошего дня и отличного настроения!!! СПАСИБО
:up:

Автор - Кузьмич
Дата добавления - 01.10.2024 в 10:48
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!