Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Преобразование макроса Если в Цикл и определение исходной ячейки
 
#1
24.01.2015 03:11:58
Тема такая, есть таблица (см. вложение), в которой находятся блоки идентичные друг другу через одинаковое друг от друга расстояние.
Написал макрос чтобы он копировал блок, в котором находится активная ячейка, со смещением вниз на 132 строки (не спрашвайте зачем 132, так надо просто).
Групп блоков всего 7 (поэтому и прописано соответствующее кол-во условий If). Суть в том, что макрос высчитывает активную ячейку, прибавляет к ней 132 и, если номер строки будет больше 920, макрос должен остановиться.
Ну так вот, макрос вроде делает все как надо, но я хотел бы добавить в него чтобы он возвращался в исходную ячейку (потому что можно запустить макрос не с 1 блока, а, допустим, с 7-8 итд), с которой начал. Ни как не соображу как это сделать.
Еще я хотел сделать цикл (чтобы макрос не был таким огромным), но не получилось что-то... Может есть у кого какие идеи?
Файл прикладываю.

А вот макрос:
Код
'Этой функцией вычисляю в каком именованом диапазоне находится активная ячейка
Function arnm(cell As Range) As String
Dim x
On Error Resume Next
For Each x In Application.Names
If Intersect(x.RefersToRange, cell) Is Nothing Then
Else
arnm = arnm & x.Name & " "
End If
Next
arnm = Trim(arnm)
End Function

'Здесь вычисляю активную ячейку
Private Sub stat()
Dim s
s = arnm(Cells(ActiveCell.Row, ActiveCell.Column))
Range(s).Select
End Sub

'Эта функция при нажатии на кнопку запускает макрос заполнения
Private Sub cmbutton_Click()
stat
Selection.Copy
acr = ActiveCell.Row + 132

'Здесь описываю что делать при ошибке
On Error GoTo Err_Handler

'А тут начинается перечисление условий
If acr < 920 Then
ActiveCell.Offset(132, 0).Select
stat
ActiveSheet.Paste
acr = ActiveCell.Row + 132

If acr < 920 Then
ActiveCell.Offset(132, 0).Select
stat
ActiveSheet.Paste
acr = ActiveCell.Row + 132

If acr < 920 Then
ActiveCell.Offset(132, 0).Select
stat
ActiveSheet.Paste
acr = ActiveCell.Row + 132

If acr < 920 Then
ActiveCell.Offset(132, 0).Select
stat
ActiveSheet.Paste
acr = ActiveCell.Row + 132

If acr < 920 Then
ActiveCell.Offset(132, 0).Select
stat
ActiveSheet.Paste
acr = ActiveCell.Row + 132

If acr < 920 Then
ActiveCell.Offset(132, 0).Select
stat
ActiveSheet.Paste
Application.CutCopyMode = False
Else
Application.CutCopyMode = False
Cells(ActiveCell.Row, ActiveCell.Column).Select
Exit Sub
End If
End If
End If
End If
End If
End If


Err_Handler:
Application.CutCopyMode = False
Cells(ActiveCell.Row, ActiveCell.Column).Select
Exit Sub

Cells(ActiveCell.Row, ActiveCell.Column).Select
End Sub
 
 
 
#2
24.01.2015 13:38:03
Цитата
Cells(ActiveCell.Row, ActiveCell.Column).Select
Зачем такая конструкция, если активная ячейка и так выделена?
 
 
 
#3
24.01.2015 13:41:23
В конце функции это добавлено для того чтобы с диапазона выделенного последнего снималось выделение.
 
 
 
#4
24.01.2015 14:52:00
Цитата
andrey062006 пишет: чтобы с диапазона выделенного последнего снималось выделение.
А зачем его выделять?
 
 
 
#5
24.01.2015 15:07:10
Ну да, надо заменить Range(s).Select на Range(s).Copy
Но суть вопроса то не в этом же)))
 
 
 
#6
24.01.2015 15:19:09
А в чём суть? И Вам правильно сказал Kuzmich по поводу активной ячейки: если нужно запомнить её адрес, то присвойте переменной её адрес:
Код
Переменная = activecell.address
А если Вы не будете использовать Select'ы, то и запоминать ничего не нужно
Также не могу понять, зачем многократно проверять одно и то же условие и что-то выделять:

Код
 If acr < 920 Then
ActiveCell.Offset(132, 0).Select
 
 
 
#7
24.01.2015 15:22:02
Цитата
Юрий М пишет: зачем многократно проверять одно и то же условие и что-то выделять
А как сделать чтобы не проверять?
Я хотел цикл сделать но не получилось(
Может быть подскажете как сделать лучше?
 
 
 
#8
24.01.2015 18:14:06
Если так..
 
 
 
#9
24.01.2015 18:37:49
это не совсем то, что нужно, макрос должен вычислить в каком диапазоне находится активная ячейка, скопировать его и вставить в другой диапазон который находится на 132 строки ниже, при чем не только в следующий диапазон, который ниже текущего на 132 строки, но и в следующие диапазоны, каждый из которых смещается на 132 строки, но не дальше чем 920 строка
Изменено: andrey062006 - 24.01.2015 18:43:15
 
 
 
#10
24.01.2015 19:51:11
Попробуйте так:

Код
Sub Макрос1()
stat
  n = 1
  Do
    acr = ActiveCell.Row + 132 * n
        Selection.Copy Cells(acr, 2)
        n = n + 1
  Loop While acr < 920
Ваша конструкция Cells(ActiveCell.Row, ActiveCell.Column) это просто ActiveCell
 
 
 
#11
24.01.2015 19:58:34
Дурна задачка
Код
Sub Мяв()
    Dim aRange As Range, aCell As Range
    Dim nm As Name
    Set aCell = ActiveCell
    Do While aCell.Row < 920 'aCell.Offset(132).Row < 920
        For Each nm In Application.Names
            If Not Intersect(nm.RefersToRange, aCell) Is Nothing Then
                Set aRange = Range(nm)
            End If
        Next
        If aRange Is Nothing Then Exit Sub
        Set aCell = Cells(aRange.Offset(132).Row, 2)
        aRange.Copy aCell
    Loop
End Sub
 
 
 
#12
24.01.2015 20:21:19
Kuzmich, Ваш макрос хорош, но он получается только 1 раз проверяет, входит ли, смещенная на 132 строки, ячейка в именованный диапазон или нет, а дальше просто штампует без проверки на вхождение в именованный диапазон. А мне нужно чтобы он именно проверял каждый раз входит ли ячейка, куда будут вставляться данные в хоть какой-то диапазон...

RAN, Ваш макрос почему то у меня не сработал(
 
 
 
#13
26.01.2015 16:58:42
Если правильно понял задачу..
 
 
 
#14
26.01.2015 17:44:59
Маугли, ну да, супер! То что нужно) Спасибо! А как сделать чтобы она не по маске zzz+1 искала а просто по вхождению в диапазон? Или тут фишка именно в том что все блоки в диспетчере имен проименованны по порядку?

Попробовал присвоить кнопке формы, не получилось. Форма запускается с параметром (ByVal Target As Range, Cancel As Boolean) по клику на листе, а при клике на кнопку такое прописать не дает((((((((((((
Изменено: andrey062006 - 26.01.2015 17:59:10
 
 
 
#15
26.01.2015 18:22:16
Если у Вас одна вкладка, то вместо target Activecell
 
 
 
#16
27.01.2015 15:25:29
Маугли, тогда она смещается на 2 строки почему то + выходит на ошибку...
 
 
 
#17
27.01.2015 17:44:38
У меня не смещается..
Обычно я решаю, когда у меня что-то не получается )
Это интересней и заводит.
 
 
 
#18
28.01.2015 18:14:05
Маугли, да, не смещается, я извиняюсь, у себя ошибку нашел. Спасибо ОГРОМНОЕ за макрос!)
Изменено: andrey062006 - 01.02.2015 13:49:23
 
 
 
#19
01.02.2015 13:49:40
Маугли, а можно как то ограничить вручную количество диапазонов, в которые копируются, ну допустим я хочу скопировать первый диапазон первого блока в 1 диапазон второго и третьего блока, а в четвертый блок мне уже не надо копировать. Я допустим ставлю в ячейку значение сколько диапазонов мне нужно заполнить вперед и макрос заполняет и останавливается...
Просто в Вашем коде нет обсчета блоков, а идет смещение при копирование каждый раз на 5 диапазонов вниз...
 
 
 
#20
01.02.2015 16:23:32
Попробуйте так..
 
 
 
#21
01.02.2015 19:50:37
Маугли, ОГРОМНЕЙШЕЕ спасибо!
 
 
 
Страницы: 1
Наверх