Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Копировать значения из новой строки в умной таблице в новую строку другой таблицы
 
#1
22.05.2020 22:43:19
Добрый день. Помогите, пожалуйста, написать макрос.

Задача:
Если на листе "Зибель" в умной таблице "Таблица13" появляется новая строка (путем стандартного добавления или путем записи в строку снизу новых данных), то необходимо копировать значения конкретных ячеек (после ввода значения в ячейку, находящейся в этой новой добавленной строке) на лист "Лист1" в умную таблицу "Таблица1", предварительно добавив новую строку внизу таблицы.

Ожидаемый результат: в умной таблице на Листе1 добавилась снизу новая строка, значения подставились в эту строку по маппингу, а в ячейку D6 подставилась константа "Зибель".

Файл прилагаю.

бюджет - 300 р.
Изменено: bagdasarov86 - 23.05.2020 21:00:43
 
 
 
#2
23.05.2020 21:07:26
bagdasarov86, макросы нагуглил и подогнал вроде, а вот на событие повесить не смог
НА МЯСО В ПРОФИЛЕ
 
 
 
#3
23.05.2020 21:39:34
Нашел вариант на событие на сайте.
Вроде работает, только комментарии в первую очередь надо заполнять
Еще событие не срабатывает, если в Таблица13 удалить строки
НА МЯСО В ПРОФИЛЕ
 
 
 
#4
23.05.2020 21:41:01
Михаил Л, спасибо большое.
потестил немного, т.е. макрос работает по кнопке? Если так, то не вижу необходимости в формуле "Просмотр" и в самом первом макросе, который сравнивает I1 и J1. Если макрос1 запускать, то он будет все время копировать последнюю строку.

Если мы идем с вариантом по кнопке, то можно доработать так, чтобы копирование было не последней строки, а выделенной? Ведь в таблицу строку можно добавить не только внизу, но и в середину (через стандартное добавление).
 
 
 
#5
23.05.2020 21:44:43
bagdasarov86, по какому событию вам нужно копировать строку?? - можно сделать отдельную ячейку сбоку после  заполнения вы туда вносите что хотите и тогда сразу переносится строка....
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#6
23.05.2020 21:47:47
bagdasarov86, посмотрите второй файл.
насчет доработок - если даже и захочу доработать - не смогу-не умею.
Но думаю помогут исправить, только просьбу о переносе на другой форум уберите, а то я не узнаю конечный текст макроса)
НА МЯСО В ПРОФИЛЕ
 
 
 
#7
23.05.2020 21:55:04
Да, интересный вариант. Но если в таблицу 13 добавлять строки в середину, это будет приводить к постоянному копированию последней строки.

Mershik, первоначально мысль была такой, что если в умную таблицу добавляю новую строку (вниз или в ее середину), то при заполнении в этой новой строке ячеек (которые участвуют в маппинге с др.таблицей), данные переносятся в нее.

Если такое сложно отловить, то устроит вариант:  я нахожусь в любой ячейке умной таблицы и по кнопке запускаю макрос, который из этой строки из определенных ячеек скопирует инфу в др.умную таблицу
 
 
 
#8
23.05.2020 22:23:28
bagdasarov86, работает так вносите строку - в столбце H пишите что-либо и все  и строка копируется на другой лист в последнюю строку
в модуль листа

можно еще сделать по двойному нажатию какой то ячейки строки
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("H2:H100")) Is Nothing Then
With Worksheets("Ëèñò1")
lr = .Cells(Rows.Count, 1).End(xlUp).Row + 1
    .Cells(lr, 1) = Target.Offset(0, -7)
    .Cells(lr, 2) = Target.Offset(0, -6)
    .Cells(lr, 3) = Target.Offset(0, -5)
    .Cells(lr, 4) = ActiveSheet.Name
    .Cells(lr, 6) = Target.Offset(0, -4)
    .Cells(lr, 9) = Target.Offset(0, -1)
End With
End If
End Sub
Изменено: Mershik - 23.05.2020 22:31:45
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#9
23.05.2020 23:01:02
вариант - повесить на контекстуню менюшку:
Скрытый текст
Изменено: buchlotnik - 23.05.2020 23:13:52
Соблюдение правил форума не освобождает от модераторского произвола
 
 
 
#10
23.05.2020 23:10:21
цитирование - не бездумное копироание[МОДЕРАТОР]
Mershik, спасибо. Чуть доработал по ячейке Cells(lr, 1). Чтобы код присваивался сам и копировался на исходную таблицу.
Но дальше я захотел по итогам затереть значение в столбце H и добавил Target.Offset(0, 0) = ""    Это приводит к какому-то зацикливанию и вылету. Что сделал не так?)
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("H2:H100")) Is Nothing Then
With Worksheets("Лист1")
lr = .Cells(Rows.Count, 1).End(xlUp).Row + 1
    .Cells(lr, 1) = .Cells(lr - 1, 1) + 1
    .Cells(lr, 2) = Target.Offset(0, -6)
    .Cells(lr, 3) = Target.Offset(0, -5)
    .Cells(lr, 4) = ActiveSheet.Name
    .Cells(lr, 6) = Target.Offset(0, -4)
    .Cells(lr, 9) = Target.Offset(0, -1)
End With
With Worksheets("Зибель")
    Target.Offset(0, -7) = Worksheets("Лист1").Cells(lr, 1)
    Target.Offset(0, 0) = ""
End With
End If
End Sub
 
 
 
#11
23.05.2020 23:19:23
bagdasarov86, так?
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("H2:H100")) Is Nothing Then
With Worksheets("Лист1")
If IsEmpty(Target) Then Exit Sub
lr = .Cells(Rows.Count, 1).End(xlUp).Row + 1
    .Cells(lr, 1) = .Cells(lr - 1, 1) + 1
    .Cells(lr, 2) = Target.Offset(0, -6)
    .Cells(lr, 3) = Target.Offset(0, -5)
    .Cells(lr, 4) = ActiveSheet.Name
    .Cells(lr, 6) = Target.Offset(0, -4)
    .Cells(lr, 9) = Target.Offset(0, -1)
End With
With Worksheets("Зибель")
    Target.Offset(0, -7) = Worksheets("Лист1").Cells(lr, 1)
    Target = ""
End With
End If
End Sub
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#12
23.05.2020 23:21:25
Так тоже вылетает (Target = ""), файл закрывается

Цитата
buchlotnik написал: вариант - повесить на контекстуню менюшку:
buchlotnik, заценил. Огонь!!!  
 
 
 
#13
24.05.2020 08:37:41
bagdasarov86,
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("H2:H100")) Is Nothing Then
If Target = "" Then Exit Sub
With Worksheets("Лист1")
lr = .Cells(Rows.Count, 1).End(xlUp).Row + 1
    .Cells(lr, 1) = .Cells(lr - 1, 1) + 1
    .Cells(lr, 2) = Target.Offset(0, -6)
    .Cells(lr, 3) = Target.Offset(0, -5)
    .Cells(lr, 4) = ActiveSheet.Name
    .Cells(lr, 6) = Target.Offset(0, -4)
    .Cells(lr, 9) = Target.Offset(0, -1)
End With
With Worksheets("Зибель")
    Target.Offset(0, -7) = Worksheets("Лист1").Cells(lr, 1)
    Target = ""
End With
End If
End Sub
Не бойтесь совершенства. Вам его не достичь.
 
 
 
Страницы: 1
Наверх