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

Регистрация

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

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

Страница 1 из 1 1
Модератор форума: китин, _Boroda_, DrMini

Динамический цикл (Макросы/Sub)

Динамический цикл

Дата: Пятница, 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

Ответить

Апострофф

Дата: Пятница, 27.09.2024, 09:58 | Сообщение № 2

Группа: Проверенные

Ранг: Обитатель

Сообщений: 467

Репутация: 129 ±

Замечаний: 0% ±

Excel 1997

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

Ответить

Дата: Пятница, 27.09.2024, 11:43 | Сообщение № 3

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3859

Репутация: 819 ±

Замечаний: 0% ±

365

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

webmoney: E265281470651 Z422237915069
USDT TRC20: TN8XeEF17o5KPBD9pNwYzNyruycuAc2mVD

Ответить

Дата: Пятница, 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]

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

Ответить

Дата: Пятница, 27.09.2024, 17:04 | Сообщение № 5

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3859

Репутация: 819 ±

Замечаний: 0% ±

365

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

webmoney: E265281470651 Z422237915069
USDT TRC20: TN8XeEF17o5KPBD9pNwYzNyruycuAc2mVD

Ответить

Дата: Пятница, 27.09.2024, 17:12 | Сообщение № 6

Группа: Админы

Ранг: Местный житель

Сообщений: 19569

Репутация: 4646 ±

Замечаний: ±

Excel 365 & Mac Excel

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

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Ответить

Дата: Воскресенье, 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

Ответить

Дата: Понедельник, 30.09.2024, 08:32 | Сообщение № 8

Группа: Проверенные

Ранг: Обитатель

Сообщений: 457

Репутация: 109 ±

Замечаний: 0% ±

MSO 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 (

)

указать в ячейке

Надеюсь я вас правильно понял. Удачи.

Ученик.
Одесса - Украина

Ответить

Дата: Понедельник, 30.09.2024, 08:39 | Сообщение № 9

Группа: Пользователи

Ранг: Участник

Сообщений: 77

Репутация: 2 ±

Замечаний: 0% ±

Excel 2013

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

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

Ответить

Дата: Понедельник, 30.09.2024, 08:56 | Сообщение № 10

Группа: Пользователи

Ранг: Участник

Сообщений: 77

Репутация: 2 ±

Замечаний: 0% ±

Excel 2013

Цитата MikeVol, 30.09.2024 в 08:32, в сообщении № 8 (

)

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

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

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

Ответить

Дата: Понедельник, 30.09.2024, 09:01 | Сообщение № 11

Группа: Проверенные

Ранг: Обитатель

Сообщений: 457

Репутация: 109 ±

Замечаний: 0% ±

MSO LTSC 2021 EN

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

Ученик.
Одесса - Украина

Ответить

Дата: Понедельник, 30.09.2024, 10:40 | Сообщение № 12

Группа: Пользователи

Ранг: Участник

Сообщений: 77

Репутация: 2 ±

Замечаний: 0% ±

Excel 2013

MikeVol,

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

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

Ответить

Дата: Понедельник, 30.09.2024, 11:08 | Сообщение № 13

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3859

Репутация: 819 ±

Замечаний: 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, 14:55 | Сообщение № 14

Группа: Пользователи

Ранг: Участник

Сообщений: 77

Репутация: 2 ±

Замечаний: 0% ±

Excel 2013

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

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

Ответить

Дата: Вторник, 01.10.2024, 08:44 | Сообщение № 15

Группа: Проверенные

Ранг: Обитатель

Сообщений: 457

Репутация: 109 ±

Замечаний: 0% ±

MSO LTSC 2021 EN

Цитата Кузьмич, 30.09.2024 в 14:55, в сообщении № 14 (

)

мне не понятно куда его внедрить в свой макрос

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

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

Ученик.
Одесса - Украина

Ответить

Дата: Вторник, 01.10.2024, 08:54 | Сообщение № 16

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3859

Репутация: 819 ±

Замечаний: 0% ±

365

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

webmoney: E265281470651 Z422237915069
USDT TRC20: TN8XeEF17o5KPBD9pNwYzNyruycuAc2mVD

Ответить

Дата: Вторник, 01.10.2024, 09:22 | Сообщение № 17

Группа: Пользователи

Ранг: Участник

Сообщений: 77

Репутация: 2 ±

Замечаний: 0% ±

Excel 2013

Цитата MikeVol, 01.10.2024 в 08:44, в сообщении № 15 (

)

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

[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, а сток может быть меньше в таблице или больше. Благодарю за понимание.

Цитата MikeVol, 01.10.2024 в 08:44, в сообщении № 15 (

)

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

[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, а сток может быть меньше в таблице или больше. Благодарю за понимание.Кузьмич

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

Ответить

Сообщение

Цитата MikeVol, 01.10.2024 в 08:44, в сообщении № 15 (

)

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

[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

Дата: Вторник, 01.10.2024, 10:00 | Сообщение № 18

Группа: Проверенные

Ранг: Обитатель

Сообщений: 457

Репутация: 109 ±

Замечаний: 0% ±

MSO LTSC 2021 EN

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

Ученик.
Одесса - Украина

Ответить

Дата: Вторник, 01.10.2024, 10:07 | Сообщение № 19

Группа: Друзья

Ранг: Экселист

Сообщений: 9185

Репутация: 2448 ±

Замечаний: 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

Ответить

Дата: Вторник, 01.10.2024, 10:48 | Сообщение № 20

Группа: Пользователи

Ранг: Участник

Сообщений: 77

Репутация: 2 ±

Замечаний: 0% ±

Excel 2013

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

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

Ответить

Динамический цикл (Макросы/Sub)

Страница 1 из 1
1

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