Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 27.04.2019, 07:07   #1
Petrov210217
Пользователь
 
Регистрация: 14.11.2018
Сообщений: 89
По умолчанию Нужно сократить код макроса

Доброго дня. Нужно сократить код макроса. В макросе повторяются блоки в цикле. Как я понимаю нужно добавить еще один цикл, но не вышло. Теперь обращаюсь за помощь.

Код:
Макрос1()
'
' Макрос1
' Выполняет 50 повторений
'
'
    For i = 1 To 50
    Range("B2").Select
    ActiveCell.FormulaR1C1 = i
'
'
    Range("B5").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("U6:U33").Select
    Selection.Copy
    Range("T6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AI15").Select
    Selection.Copy
    Range("R6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'
'
    Range("B5").Select
    ActiveCell.FormulaR1C1 = "2"
    Range("U6:U33").Select
    Selection.Copy
    Range("T6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AI15").Select
    Selection.Copy
    Range("R7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'
'
    Range("B5").Select
    ActiveCell.FormulaR1C1 = "3"
    Range("U6:U33").Select
    Selection.Copy
    Range("T6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AI15").Select
    Selection.Copy
    Range("R8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'
'
    Range("B5").Select
    ActiveCell.FormulaR1C1 = "4"
    Range("U6:U33").Select
    Selection.Copy
    Range("T6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AI15").Select
    Selection.Copy
    Range("R9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'
'
    Range("B5").Select
    ActiveCell.FormulaR1C1 = "5"
    Range("U6:U33").Select
    Selection.Copy
    Range("T6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("AI15").Select
    Selection.Copy
    Range("R10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'
'
    Next
    
End Sub
Как убрать все блоки и оставить только один, с помощью еще одного цикла
И как количество повторений цикла который есть сейчас вывести в ячейку на лист(А1, листа1), а то не удобно менять в самом макросе.
Спасибо.
ЫЫЫЫЫЫ
Petrov210217 вне форума Ответить с цитированием
Старый 27.04.2019, 21:10   #2
IgorGO
Новичок
СтарожилДжуниор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Сообщений: 9,487
По умолчанию

Код:
Sub BBB
  dim i&, j&
  For i = 1 To 50
    Range("B2") = i
    for j=1 to 5
      Range("B5") = j
      Range("U6:U33").Copy
      Range("T6").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
      Range("AI15").Copy
      Range("R6").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
   next
  next
End sub
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете
IgorGO вне форума Ответить с цитированием
Старый 28.04.2019, 21:18   #3
Казанский
Старожил
 
Аватар для Казанский
 
Регистрация: 31.12.2010
Сообщений: 2,133
По умолчанию

Petrov210217, объясните задачу словами, а не с помощью неработающего кода. Пока получается, что диапазон U6:U33 копируется в диапазон Т6:Т33, а AI15 - в R6, и так 50 раз. Видимо, нужно копировать со смещением, но куда - по горизонтали или по вертикали? А может, в эти же диапазоны, но на другие дисты?
exceleved@yandex.ru Яндекс.Деньги: 410011500007619
Казанский вне форума Ответить с цитированием
Старый 29.04.2019, 08:37   #4
Petrov210217
Пользователь
 
Регистрация: 14.11.2018
Сообщений: 89
По умолчанию

IgorGO спасибо за код. Сегодня буду пробовать. А выложенный мною код полностью рабочий. Все ячейки указанны верно. Я этот код взял из своей рабочей программы
ЫЫЫЫЫЫ
Petrov210217 вне форума Ответить с цитированием
Старый 04.05.2019, 13:11   #5
Petrov210217
Пользователь
 
Регистрация: 14.11.2018
Сообщений: 89
По умолчанию

IgorGO спасибо за код. Проверил, код хорошо работает, но есть нюанс:
Код:
Range("AI15").Copy
      Range("R6").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
копируется всегда из Range("AI15"), а вставляется:
j=1 в Range("R6")
j=1 в Range("R7")
j=1 в Range("R8")
и т.д, то есть при каждой итерации на строку ниже пока цикл j не закончится, затем все начинается заново.

И как задавать значения i и j из ячеек A1 и А2 из рабочего листа 1 текущей книги?
ЫЫЫЫЫЫ
Petrov210217 вне форума Ответить с цитированием
Старый 04.05.2019, 13:33   #6
IgorGO
Новичок
СтарожилДжуниор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Сообщений: 9,487
По умолчанию

Код:
Sub BBB
  dim i&, j&
  For i = 1 To [A1]
    Range("B2") = i
    for j=1 to [A2]
      Range("B5") = j
      Range("U6:U33").Copy
      Range("T6").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
      Range("AI15").Copy
      Range("R" & 5+j).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
   next
  next
End sub
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете
IgorGO вне форума Ответить с цитированием
Старый 05.05.2019, 19:33   #7
Petrov210217
Пользователь
 
Регистрация: 14.11.2018
Сообщений: 89
По умолчанию

Теперь все как нужно, спасибо!!!
ЫЫЫЫЫЫ
Petrov210217 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
сделала запись макроса на 4х строчках, в итоге он выполняет 4 строки а мне нужно 10000, можно ли просто исправить мой макрос? Татьяна0602 Microsoft Office Word 14 09.04.2019 17:18
число 2,34569 , нужно преобразовать в строку, сократить до двух символов после запятой и вывести в MEMO Dpemik Общие вопросы Delphi 10 04.06.2017 09:24
Вызов макроса внутри другого макроса. Небесный Microsoft Office Word 1 05.11.2012 22:38
Нужно упростить (не сократить) задачу. PascalAbc. AntoshkaK Паскаль, Turbo Pascal, PascalABC.NET 13 04.12.2011 02:26
Как сократить время выполнения макроса? Алексей11111 Microsoft Office Excel 11 01.12.2009 20:04