Добрый день! Задача следующая: при заполнении яч. А6-D6 или А11-D11 (крайне неопытным пользователем !!!), можно ли сделать автоматическое добавление строки ниже с обязательным сохранением формул в столбцах E и F, например, как только будет внесена фамилия с столбец А?
Добрый день! Задача следующая: при заполнении яч. А6-D6 или А11-D11 (крайне неопытным пользователем !!!), можно ли сделать автоматическое добавление строки ниже с обязательным сохранением формул в столбцах E и F, например, как только будет внесена фамилия с столбец А?Leprotto
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub nextR = Target.Row + 1 Debug.Print InStr(Cells(nextR, 1), "отдел") If InStr(Cells(nextR, 1), "отдел") > 0 And Target.Value <> "" Then Rows(nextR).Insert Shift:=xlDown Range("e" & Target.Row - 1 & ":f" & Target.Row - 1).Copy Range("e" & Target.Row & ":f" & Target.Row) End If End Sub
[/vba]
Leprotto, как-то так:[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub nextR = Target.Row + 1 Debug.Print InStr(Cells(nextR, 1), "отдел") If InStr(Cells(nextR, 1), "отдел") > 0 And Target.Value <> "" Then Rows(nextR).Insert Shift:=xlDown Range("e" & Target.Row - 1 & ":f" & Target.Row - 1).Copy Range("e" & Target.Row & ":f" & Target.Row) End If End Sub
Leprotto, тыкаете ПКМ по ярлычку листа, в котором нужно добавлять строки, выбираете "исходный текст", вставляете в открывшееся окно код из моего файла. Если структура Вашего листа сильно отличается от файла-примера, пишите в чем именно отличия, а лучше показывайте.
Leprotto, тыкаете ПКМ по ярлычку листа, в котором нужно добавлять строки, выбираете "исходный текст", вставляете в открывшееся окно код из моего файла. Если структура Вашего листа сильно отличается от файла-примера, пишите в чем именно отличия, а лучше показывайте.Manyasha
Manyasha, отличается сильно )) прикладываю. - добавление строк необходимо при заполнении яч. Е24, 26,28...Е325; - с сохранением формул с столбцах D,R,S,T,U
Manyasha, отличается сильно )) прикладываю. - добавление строк необходимо при заполнении яч. Е24, 26,28...Е325; - с сохранением формул с столбцах D,R,S,T,ULeprotto
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub 'Если изменяем НЕ колонка C (3-я по номеру), выходим из макроса If Target.Column <> 3 Then Exit Sub nextR = Target.Row + 1 'Смотрим на колонку C, проверяем значение следующей строчки 'Если содержит текст "филиал" или "ДЗО ", вставляем еще одну строчку If (InStr(Cells(nextR, 3), "филиал") > 0 Or InStr(Cells(nextR, 3), "ДЗО ") > 0) And Target.Value <> "" Then Application.EnableEvents = False Rows(nextR).Insert Shift:=xlDown 'Копируем формулы по столбцу D Range("d" & Target.Row).Copy Range("d" & Target.Row + 1) 'Копируем формулы по столбцам R:U Range("r" & Target.Row & ":u" & Target.Row).Copy Range("r" & Target.Row + 1 & ":u" & Target.Row + 1) Application.EnableEvents = True End If End Sub
[/vba]
В моем первом варианте не правильно копировались формулы, здесь поправила. Если где-то еще с логикой не догнала говорите) [p.s.]Файл пришлось немного урезать[/p.s.]
Проверяйте. Вот код с комментариями:
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub 'Если изменяем НЕ колонка C (3-я по номеру), выходим из макроса If Target.Column <> 3 Then Exit Sub nextR = Target.Row + 1 'Смотрим на колонку C, проверяем значение следующей строчки 'Если содержит текст "филиал" или "ДЗО ", вставляем еще одну строчку If (InStr(Cells(nextR, 3), "филиал") > 0 Or InStr(Cells(nextR, 3), "ДЗО ") > 0) And Target.Value <> "" Then Application.EnableEvents = False Rows(nextR).Insert Shift:=xlDown 'Копируем формулы по столбцу D Range("d" & Target.Row).Copy Range("d" & Target.Row + 1) 'Копируем формулы по столбцам R:U Range("r" & Target.Row & ":u" & Target.Row).Copy Range("r" & Target.Row + 1 & ":u" & Target.Row + 1) Application.EnableEvents = True End If End Sub
[/vba]
В моем первом варианте не правильно копировались формулы, здесь поправила. Если где-то еще с логикой не догнала говорите) [p.s.]Файл пришлось немного урезать[/p.s.]Manyasha
Manyasha, с формулами все ОК! Мне лучше бы добавление строк при внеснии в столбец Е, чем в С. Попробовал сам переделать - все перестало работать :-( И можно ли сделать сохранение формата ячеек? (вертикальные границы пропадают)
Manyasha, с формулами все ОК! Мне лучше бы добавление строк при внеснии в столбец Е, чем в С. Попробовал сам переделать - все перестало работать :-( И можно ли сделать сохранение формата ячеек? (вертикальные границы пропадают)Leprotto
Manyasha, посмотрите, пожалуйста, приложенный файл. Яч. Е127 и Е216 (последние строки в "блоке") не реагируют на макрос, т.е. при внесении даты не добавляется новая строка. При копировании блока та же проблема.
Manyasha, посмотрите, пожалуйста, приложенный файл. Яч. Е127 и Е216 (последние строки в "блоке") не реагируют на макрос, т.е. при внесении даты не добавляется новая строка. При копировании блока та же проблема.Leprotto
'Если содержит текст "филиал" или "ДЗО ", вставляем еще одну строчку If (InStr(Cells(nextR, 3), "филиал") > 0 Or InStr(Cells(nextR, 3), "ДЗО ")) And Target.Value <> "" Then
[/vba] На содержание в строке текста "Итого" нет проверки, нужно добавить:[vba]
Код
If (InStr(Cells(nextR, 3), "филиал") > 0 Or InStr(Cells(nextR, 3), "ДЗО ") Or InStr(Cells(nextR, 3), "Итого ") > 0) And Target.Value <> "" Then
[/vba] Вообще, если будет много таких критериев, то возможно излишнее добавление строк, например, если в НЕ итоговой строчке текст будет содержать "филиал", то при редактировании строчки выше, макрос будет добавлять строку. (Привела пример в файле в 1-м блоке после строки "филиал 2"). Так что, может Вам лучше придумать другой критерий добавление строки, например, цвет заливки следующей ячейки (в файле под комментами)[vba]
Код
If Cells(nextR, 3).Interior.ColorIndex <> -4142 And Target.Value <> "" Then
[/vba]
Leprotto, здравствуйте. Из макроса:[vba]
Код
'Если содержит текст "филиал" или "ДЗО ", вставляем еще одну строчку If (InStr(Cells(nextR, 3), "филиал") > 0 Or InStr(Cells(nextR, 3), "ДЗО ")) And Target.Value <> "" Then
[/vba] На содержание в строке текста "Итого" нет проверки, нужно добавить:[vba]
Код
If (InStr(Cells(nextR, 3), "филиал") > 0 Or InStr(Cells(nextR, 3), "ДЗО ") Or InStr(Cells(nextR, 3), "Итого ") > 0) And Target.Value <> "" Then
[/vba] Вообще, если будет много таких критериев, то возможно излишнее добавление строк, например, если в НЕ итоговой строчке текст будет содержать "филиал", то при редактировании строчки выше, макрос будет добавлять строку. (Привела пример в файле в 1-м блоке после строки "филиал 2"). Так что, может Вам лучше придумать другой критерий добавление строки, например, цвет заливки следующей ячейки (в файле под комментами)[vba]
Код
If Cells(nextR, 3).Interior.ColorIndex <> -4142 And Target.Value <> "" Then
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
