Страницы: 1
RSS
Добавление строк в одной таблице в разных местах
 

Добрый день.

Помогите с написанием макроса.

В таблице в нескольких местах нужно вставить строки «по кнопке» в конкретный диапазон. Одна кнопка на свой заданный диапазон.

При добавлении строк в диапазон, который выше остальных диапазонов строка вставляется и соответственно сдвигает адрес строки для вставки в диапазоны, что ниже.

Знаний не хватает, как это сделать. Вот пример как это должно по идее выглядеть . В идеале рядом с кнопкой добавления должна быть и кнопка  удаления строки в конкретном диапазоне. То есть добавил 5 строк в первый диапазон внес 5 статей затрат, решил что две можно объединить и удалением одну строку убрал, при этом нижние кнопки при добавлении «не поедут» по таблице

 
Есть у кого-нибудь идеи? Или это очень сложно реализовать?
 
Цитата
Алексей Иванов написал:
добавил 5 строк
диапазон кнопки уже другой? покажите данные исходные а рядом что должно получится

Вам может стоит подумать о том для чего Вам это и описать так как это может быть не верным для вас вариантом решения....или просто неудобным и не рациональным
Изменено: Mershik - 30.10.2020 10:32:46
Не бойтесь совершенства. Вам его не достичь.
 
Цитата
Mershik написал:
описать так как это может быть
В прикрепленном файле примерно то, что должно получиться.
То есть когда я вставляю по кнопке новые строки в диапазон "здания и сооружения " там все более менее понятно. Однако при вставке в диапазон "здания и сооружения" следующие диапазоны таблицы (например "оборудование") смещаются на кол-во вставленных строк.
Изменено: Алексей Иванов - 30.10.2020 13:09:00
 
Алексей Иванов, как много у вас категорий основных средств?
Не бойтесь совершенства. Вам его не достичь.
 
Цитата
Mershik написал:
как много у вас категорий основных средств?
Детализация по категориям может меняться, что-то объединяться, что-то выноситься отдельно, на данный момент 5 категорий. Причем данный шаблон (кнопки макросов + -)  может быть применен и в других таблицах, например статьи затрат и тд.
 
Алексей Иванов, т.е. вы хотите создавать кучу кнопок? лучше возможно справа от группы делать двойной щелчок по ячейке и добавлять а следующая удалять...
вопрос как определить группу ? по жирности шрифта можно? - эты вопросы связаны что бы можно было определить группу..так как сейчас кроме этого ничего нет...

короче сделал для двух верхних кнопок - для остальных по аналогии но менять начало диапазона в данном случае nachalo = 3 (на 1 строку ниже чем нужная группа)
для кнопки +
Код
Sub add_row()
Dim i As Long, lr As Long
nachalo = 3
With Worksheets("Лист1")
lr = .Cells(Rows.Count, 1).End(xlUp).Row
For i = nachalo To lr
If .Cells(i, 1).Font.Bold = True Then
    .Rows(i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Exit Sub
End If
Next i
End With
End Sub
для кнопки -
Код
Sub delete_row()
Dim i As Long, lr As Long
nachalo = 3
With Worksheets("Лист1")
lr = .Cells(Rows.Count, 1).End(xlUp).Row
For i = nachalo To lr
If .Cells(i, 1).Font.Bold = True Then
    .Rows(i - 1).Delete Shift:=xlUp
    Exit Sub
End If
Next i
End With
End Sub

Изменено: Mershik - 30.10.2020 12:44:10
Не бойтесь совершенства. Вам его не достичь.
 
Mershik, Наличие кнопок условие заказчика. Возможно увидев конечный результат он поймет что это выглядит аляписто и будет возможно убедить его в идее двойного нажатия как вы предлагаете. Вопрос с определением принадлежности к группе (шрифт, заливка) наверно не особо важно как это будет происходить. А нельзя присвоением имени определять диапазон?  
Изменено: Алексей Иванов - 30.10.2020 13:12:04
 
Алексей Иванов,
Цитата
А нельзя присвоением имени определять диапазон?
не понял имеете ввиду через диспетчер имен?(CTRL+F3)
Не бойтесь совершенства. Вам его не достичь.
 
Mershik,  Я обязательно попробую Ваше решение как доберусь до рабочего места. Спасибо за старания. Отпишусь по результатам, спасибо
Изменено: Алексей Иванов - 30.10.2020 13:12:36
 
Алексей Иванов, поправите ВСЕ ответы с цитированием полного сообщения для ответа есть кнопка имя, для конкретного цитирования нужно выделить часть текста и нажать цитировать. Модераторы будут ругаться.
Изменено: Mershik - 30.10.2020 12:56:35
Не бойтесь совершенства. Вам его не достичь.
 
Mershik, да через диспетчер имен, это же определение диапазона и присвоение ему имени. Так пусть макрос в этом определенном диапазоне вставляет, удаляет строки сколько хочет. Но это я точно не знаю возможно ли такое вообще технически

Зы поменял цитирования
 
Алексей Иванов, ну вот есть диапазона А1:A5 - назвали вы его "Категория1" и   есть А6:A9 - "Категория2"  - уже получается при добавление диапазон должен меняться. ну это уже другая история как мне кажется и к текущей теме не имеет никакого отношения
Не бойтесь совершенства. Вам его не достичь.
 
Mershik, А почему в начале все нормально добавляется, а затем разные "плюсики" начинают добавлять строки только сверху? И еще вопрос не могли бы Вы расписать код, для понимания, что делается.  
 
вот описание, но сейчас скорректирую макрос, так как забыл что при добавлении строк будет меняться и строка начало.
Код
Sub add_row()
Dim i As Long, lr As Long 'объявление переменных
nachalo = 3 ' как выше писал это номер строки с которой будет искать код т.к. в какой расположен +, соответственно необходимо указывать для каждого плюсика свой
With Worksheets("Лист1") ' указываем с каким листом будем работать (что бы постоянно его не прописывать)
lr = .Cells(Rows.Count, 1).End(xlUp).Row 'определяем последнюю заполненную ячейку
For i = nachalo To lr 'цикл по ячейкам с 1 (та которая указана как начало для каждого плюсика) до последней
If .Cells(i, 1).Font.Bold = True Then 'проверяем ячейку что бы шрифт в ней был полужирный и если это так добавляем строку выше и завершаем макрос
    .Rows(i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 'само добавление строки
    Exit Sub'завершение макроса
End If
Next i
End With
End Sub
Не бойтесь совершенства. Вам его не достичь.
 
Mershik, Спасибо за помощь!

ЗЫ. Могу я обратиться к Вам в личку?
 
Алексей Иванов, касаемо темы, лучше тут - могут лучше вариант предложить.
кнопки обязательны? - можно просто по двойному левой кнопки мыши добавлять и удалять на соседние столбцы
Изменено: Mershik - 02.11.2020 09:27:10
Не бойтесь совершенства. Вам его не достичь.
 
Mershik, я просто поднял старые наши расчеты. К сожалению человека которые писал макросы уже нет. Так вот у меня есть пример именно того макроса что мы ищем. По идее достаточно его просто вычленить. Файл большой я его выложить тут не могу

Хотя Вы уже почти сами дописали его
Изменено: Алексей Иванов - 02.11.2020 09:37:43
 
Цитата
Mershik написал:
кнопки обязательны?
Собственно только из-за кнопок это и делается. "Можно сделать кнопку что бы у меня строка сама добавлялась" примерно так задание было поставлено
 
Алексей Иванов,  пока с недоработкой в плане последней группы ( потестите пока что)
для вставки
Код
Sub add_row()
Dim i As Long, lr As Long
nachalo = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row + 1
With Worksheets("Лист1")
lr = .Cells(Rows.Count, 1).End(xlUp).Row
For i = nachalo To lr
If lr > i Then
    If .Cells(i, 1).Font.Bold = True Then
        .Rows(i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Exit Sub
    End If
Else
    .Rows(i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Next i
End With
End Sub
для удаления
Код
Sub delete_row()
Dim i As Long, lr As Long
nachalo = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row + 1
With Worksheets("Лист1")
lr = .Cells(Rows.Count, 1).End(xlUp).Row
For i = nachalo To lr
If lr > i Then
    If .Cells(i, 1).Font.Bold = True Then
        .Rows(i - 1).Delete Shift:=xlUp
        Exit Sub
    End If
Else
    .Rows(i).Delete Shift:=xlUp
    Exit Sub
End If
Next i
End With
End Sub
Не бойтесь совершенства. Вам его не достичь.
 
Mershik, выдает ошибку  
Изменено: Алексей Иванов - 02.11.2020 10:34:31
 
Алексей Иванов, случайно удалил - добавте end if перед next i  (Как во втором макросе на удаление)
1
Код
Sub add_row()
Dim i As Long, lr As Long
nachalo = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row + 1 'определяем в какой строке расположена кнопка + 1 строка
With Worksheets("Лист1") 'указываем лист с каким будем работать
lr = .Cells(Rows.Count, 1).End(xlUp).Row 'определяем в нем последнюю заполненную ячейку
For i = nachalo To lr 'перебираем ячейки которые ниже кнопки по порядку
If lr > i Then ' проверяем чтобы не была последняя ячейка если да то идем дальше если нет к ELSE
    If .Cells(i, 1).Font.Bold = True Then ' если не последняя проверяем полужирный ли текст или нет
        .Rows(i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove ' если полужирный вставляем выше 1 строку
        .Cells(i, 1) = "...Внесите данные..." 'добавляем текст
        Exit Sub 'завершаем макрос
    End If
Else
    .Rows(i).Copy 'копируем последнюю строку что бы получить формат
    .Rows(i + 1).Insert Shift:=xlDown , вставляем ее ниже 1 строку
    .Rows(i + 1).ClearContents 'очищаем текст
    .Cells(i + 1, 1) = "...Внесите данные..." 'добавляем текст
End If
Next i
End With
End Sub
2
Код
Sub delete_row()
Dim i As Long, lr As Long
nachalo = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row + 1
With Worksheets("Лист1")
lr = .Cells(Rows.Count, 1).End(xlUp).Row
For i = nachalo To lr
If lr > i Then
    If .Cells(i, 1).Font.Bold = True Then
        .Rows(i - 1).Delete Shift:=xlUp
        Exit Sub
    End If
Else
    .Rows(i).Delete Shift:=xlUp
    Exit Sub
End If
Next i
End With
End Sub
Изменено: Mershik - 02.11.2020 11:12:43
Не бойтесь совершенства. Вам его не достичь.
 
Mershik, все отлично работает, кроме последней группы (Как вы и говорили)  
не актуально
Изменено: Алексей Иванов - 02.11.2020 11:01:26
 
Алексей Иванов, у меня последняя работает удаляете и добавляет..что не так?
Изменено: Mershik - 02.11.2020 11:00:57
Не бойтесь совершенства. Вам его не достичь.
 
Mershik, все отлично работает спасибо большое за помощь! вы меня очень сильно выручили! не распишите окончательный код (там по факту только пару строчек дописать)?
Для использования кода мне теперь достаточно только название активного листа менять, ведь так?
 
Алексей Иванов, выше добавил, на счет имя листа..возможно, но нужно же создать кнопки и назначить на них макрос..
Изменено: Mershik - 02.11.2020 11:15:32
Не бойтесь совершенства. Вам его не достичь.
 
Mershik,Понятно. Буду тестить. Пока все работает спасибо
 
Mershik, Добрый день подскажите пожалуйста, что нужно дописать/убрать в коде , что бы помимо надписи "Внесите данные" в соседние ячейки копировались формулы с предыдущих строк, если такое возможно конечно. Спасибо
Страницы: 1
Наверх