Динамический цикл
Кузьмич
Дата: Пятница, 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]
[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 - будет проще понять что вообще хотите. Хотя вряд ли... ((
Кузьмич , уберите из кода все ActiveWindow.ScrollRow - будет проще понять что вообще хотите. Хотя вряд ли... ((Hugo
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] Кузьмич
Ну, теперь вся утка наша...
Ответить
Сообщение Вот так? [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, но задачу с файлом никто тут не видел.
Ну если судить по коду - тут цикл не нужен, можно только лишнее повыкидывать. Но если знать задачу - можно например в цикле менять 4 до 1004, но задачу с файлом никто тут не видел. Hugo
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
Кузьмич , оформите код тегами с помощью кнопки # в режиме правки поста. Первый пост исправила за Вас, дальше уже сами
Кузьмич , оформите код тегами с помощью кнопки # в режиме правки поста. Первый пост исправила за Вас, дальше уже самиPelena
"Черт возьми, Холмс! Но как??!!" Ю-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]
[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
Кузьмич , Доброго времени суток. чтоб не нажимать кнопку более 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 это и есть ваша Надеюсь я вас правильно понял. Удачи.
Кузьмич , Доброго времени суток. чтоб не нажимать кнопку более 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 это и есть ваша Надеюсь я вас правильно понял. Удачи.MikeVol
Ученик.
Ответить
Сообщение Кузьмич , Доброго времени суток. чтоб не нажимать кнопку более 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 это и есть ваша Надеюсь я вас правильно понял. Удачи.Автор - 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 раз, как мне это осуществить? Что требуется добавить до кода и после, чтоб он автоматом крутил требуемое количество раз (счетчик и код цикла по счетчику)? Благодарю за понимание!Кузьмич
Ну, теперь вся утка наша...
Ответить
Сообщение 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. Кузьмич
Ну, теперь вся утка наша...
Ответить
Сообщение 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
Ученик.
Ответить
Сообщение Кузьмич , Можете файл пример приложить для отладки кода?Автор - 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
данный цикл нужно запустить 1500 раз или 6000 раз
[vba]Код
sub skokoraz() dim i& for i=1 to skokonado call ЦИКЛ next end sub
[/vba] Этот макрос разместить рядом и запустить, вместо skokonado указать число, можно его брать из ячейки.
данный цикл нужно запустить 1500 раз или 6000 раз
[vba]Код
sub skokoraz() dim i& for i=1 to skokonado call ЦИКЛ next end sub
[/vba] Этот макрос разместить рядом и запустить, вместо skokonado указать число, можно его брать из ячейки.Hugo
webmoney: E265281470651 Z422237915069 USDT TRC20: TN8XeEF17o5KPBD9pNwYzNyruycuAc2mVD
Сообщение отредактировал Hugo - Понедельник, 30.09.2024, 11:09
Ответить
Сообщение данный цикл нужно запустить 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 , благодарю за предложение, но я далёк от программирования и мне не понятно куда его внедрить в свой макрос. Ведь там должен быть правильно выставлен алгоритм действий.Кузьмич
Ну, теперь вся утка наша...
Ответить
Сообщение Hugo , благодарю за предложение, но я далёк от программирования и мне не понятно куда его внедрить в свой макрос. Ведь там должен быть правильно выставлен алгоритм действий.Автор - Кузьмич Дата добавления - 30.09.2024 в 14:55
MikeVol
Дата: Вторник, 01.10.2024, 08:44 |
Сообщение № 15
Группа: Проверенные
Ранг: Обитатель
Сообщений: 358
Репутация:
68
±
Замечаний:
0% ±
Excel LTSC 2021 EN
мне не понятно куда его внедрить в свой макрос
Смотрите файл.
мне не понятно куда его внедрить в свой макрос
Смотрите файл.MikeVol
Ученик.
Ответить
Сообщение мне не понятно куда его внедрить в свой макрос
Смотрите файл.Автор - MikeVol Дата добавления - 01.10.2024 в 08:44
Hugo
Дата: Вторник, 01.10.2024, 08:54 |
Сообщение № 16
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3595
Репутация:
779
±
Замечаний:
0% ±
365
Кузьмич , ну я ведь всё написал, читайте и понимайте буквально каждое слово )) В программировании так - каждое слово имеет значение ))
Кузьмич , ну я ведь всё написал, читайте и понимайте буквально каждое слово )) В программировании так - каждое слово имеет значение ))Hugo
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, а сток может быть меньше в таблице или больше. Благодарю за понимание.Кузьмич
Ну, теперь вся утка наша...
Ответить
Сообщение [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
Ученик.
Ответить
Сообщение Не-а, я пас. Что-то я в ступор зашёл. Извините. Автор - 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]
[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
Ю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:Кузьмич
Ну, теперь вся утка наша...
Ответить
Сообщение Nic70y , Благодарю от души тебя! Всё сработало как нужно!MikeVol , И тебе благодарность за помощь! Всем здравия, хорошего дня и отличного настроения!!! СПАСИБО :up:Автор - Кузьмич Дата добавления - 01.10.2024 в 10:48