Добрый день еще раз всем!!! Можно ли связать две таблицы!? На листе В25 имеется таблица "основная" (с возможным увеличением количества строк для расчетов) На втором листе "Заключение" данная таблица должна будет дублироваться (данный лист будет доступен лишь для печати - там много еще будет информации) Как можно было бы сделать взаимосвязь этих таблиц Спасибо ОГРОМНОЕ заранее за помощь и подсказки
Добрый день еще раз всем!!! Можно ли связать две таблицы!? На листе В25 имеется таблица "основная" (с возможным увеличением количества строк для расчетов) На втором листе "Заключение" данная таблица должна будет дублироваться (данный лист будет доступен лишь для печати - там много еще будет информации) Как можно было бы сделать взаимосвязь этих таблиц Спасибо ОГРОМНОЕ заранее за помощь и подсказкиanisimovaleksandr32
Админ прошу прощение а можно данную тему в макросы перенести... Как я понял формулами можно но не так как нужно Разыскал код, может на другой ветке помогут его подправить [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("Таблица3[#All]")) Is Nothing Then Application.EnableEvents = 0 Range("A2:Y36").Copy Sheets("Лист1").Cells(2, 1) Application.EnableEvents = 1 End If End Sub
[/vba] Спасибо огромное за ранее
Админ прошу прощение а можно данную тему в макросы перенести... Как я понял формулами можно но не так как нужно Разыскал код, может на другой ветке помогут его подправить [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("Таблица3[#All]")) Is Nothing Then Application.EnableEvents = 0 Range("A2:Y36").Copy Sheets("Лист1").Cells(2, 1) Application.EnableEvents = 1 End If End Sub
Помогите пжл дополнить усовершенствовать его: Если вдруг оператор увеличил количество строк "основную таблицу" Или же уменьшил количество строк в "основной таблице" Если дополнять строки или удалять их в центре основной таблицы то по сути данный код срабатывает
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("Таблица3[#All]")) Is Nothing Then Application.EnableEvents = 0 Range("A2:Y36").Copy Sheets("Лист1").Cells(2, 1) Application.EnableEvents = 1 End If End Sub
[/vba]
Но если же я "основную таблицу" протягиваю вниз - тем самым дополняя количество строк то я вынужден в коде еще и изменить диапазон [vba]
Помогите пжл дополнить усовершенствовать его: Если вдруг оператор увеличил количество строк "основную таблицу" Или же уменьшил количество строк в "основной таблице" Если дополнять строки или удалять их в центре основной таблицы то по сути данный код срабатывает
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("Таблица3[#All]")) Is Nothing Then Application.EnableEvents = 0 Range("A2:Y36").Copy Sheets("Лист1").Cells(2, 1) Application.EnableEvents = 1 End If End Sub
[/vba]
Но если же я "основную таблицу" протягиваю вниз - тем самым дополняя количество строк то я вынужден в коде еще и изменить диапазон [vba]
китин, спасибо за ответ - все разобрался - получилось Он и без определения последней строки получается срабатывает (просто в файлах потерялся и не туда или не так смотрел - не внимательный, факт) [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("Основная[#All]")) Is Nothing Then Application.EnableEvents = 0 Range("Основная[#All]").Copy Sheets("ЗАКЛЮЧЕНИЕ").Cells(2, 1) Application.EnableEvents = 1 End If End Sub
[/vba]
Но проблема заключается на другом листе Потому как под этой таблицей имеется другая информация А при срабатывании макроса данное копирование накладывается на эту информацию Я так понимаю тут нужно что то другое
Да и копирование происходит с формулами - нужно кумекать (в моем случае искать аналогичное решение. потому как с этим vba я не в ладах)
И вот если основную таблицу еще увеличить то на другом листе где в ячейке X52 слово ПРИМЕЧАНИЕ код сработает на ура но и слово примечание удалиться
китин, спасибо за ответ - все разобрался - получилось Он и без определения последней строки получается срабатывает (просто в файлах потерялся и не туда или не так смотрел - не внимательный, факт) [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("Основная[#All]")) Is Nothing Then Application.EnableEvents = 0 Range("Основная[#All]").Copy Sheets("ЗАКЛЮЧЕНИЕ").Cells(2, 1) Application.EnableEvents = 1 End If End Sub
[/vba]
Но проблема заключается на другом листе Потому как под этой таблицей имеется другая информация А при срабатывании макроса данное копирование накладывается на эту информацию Я так понимаю тут нужно что то другое
Да и копирование происходит с формулами - нужно кумекать (в моем случае искать аналогичное решение. потому как с этим vba я не в ладах)
И вот если основную таблицу еще увеличить то на другом листе где в ячейке X52 слово ПРИМЕЧАНИЕ код сработает на ура но и слово примечание удалитьсяanisimovaleksandr32
Нашел свою старую тему и в ней _Boroda_, Как то прописывал вот такой вот код:
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("Основная")) Is Nothing Then Set tb1_ = Sheets("Заключение").ListObjects("Основная7") With tb1_ nc_ = .ListColumns.Count nr_ = .ListRows.Count If nr_ Then .Range(1).Offset(1).Resize(nr_, nc_).Delete End If On Error Resume Next For i = 1 To nc_ Range("Основная[" & .Range(i) & "]").Copy .Range(nc_ + i) Next i On Error GoTo 0 End With End If End Sub
[/vba]
Тоже работает на УРА!!! Но вот как избежать удаления (наложения на другую информацию к примеру в ячейке X52 и последующие ниже ) как добиться кодом чтоб таблица не накладывалась на нее А также копирование происходило без формул
Нашел свою старую тему и в ней _Boroda_, Как то прописывал вот такой вот код:
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("Основная")) Is Nothing Then Set tb1_ = Sheets("Заключение").ListObjects("Основная7") With tb1_ nc_ = .ListColumns.Count nr_ = .ListRows.Count If nr_ Then .Range(1).Offset(1).Resize(nr_, nc_).Delete End If On Error Resume Next For i = 1 To nc_ Range("Основная[" & .Range(i) & "]").Copy .Range(nc_ + i) Next i On Error GoTo 0 End With End If End Sub
[/vba]
Тоже работает на УРА!!! Но вот как избежать удаления (наложения на другую информацию к примеру в ячейке X52 и последующие ниже ) как добиться кодом чтоб таблица не накладывалась на нее А также копирование происходило без формулanisimovaleksandr32
Сообщение отредактировал anisimovaleksandr32 - Четверг, 10.03.2022, 13:30
МНОГОУВАЖАЕМЫЕ ФОРУМЧАНЕ!!! Помогите пожалуйста дополнить макрос выше вот таким вот действием Когда то был рассмотрен пример: My WebPage В данном примере учитывалось условие и работа макроса через кнопку: копирование строк и вставка этих строк до "Примечания"
[vba]
Код
Public Sub Add39_58() Dim r Application.ScreenUpdating = False r = Range("B:B").Find(What:="Примечание:", LookAt:=xlWhole).Row - 1 Range("A" & r & ":A" & r + 19).EntireRow.Insert Range("B39:B58").EntireRow.Copy Range("A" & r) Application.ScreenUpdating = True End Sub
[/vba]
Как объединить работу этих двух макросов!?
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("Основная")) Is Nothing Then Set tb1_ = Sheets("Заключение").ListObjects("Основная7") With tb1_ nc_ = .ListColumns.Count nr_ = .ListRows.Count If nr_ Then .Range(1).Offset(1).Resize(nr_, nc_).Delete End If On Error Resume Next For i = 1 To nc_ Range("Основная[" & .Range(i) & "]").Copy .Range(nc_ + i) Next i On Error GoTo 0 End With End If End Sub
[/vba]
МНОГОУВАЖАЕМЫЕ ФОРУМЧАНЕ!!! Помогите пожалуйста дополнить макрос выше вот таким вот действием Когда то был рассмотрен пример: My WebPage В данном примере учитывалось условие и работа макроса через кнопку: копирование строк и вставка этих строк до "Примечания"
[vba]
Код
Public Sub Add39_58() Dim r Application.ScreenUpdating = False r = Range("B:B").Find(What:="Примечание:", LookAt:=xlWhole).Row - 1 Range("A" & r & ":A" & r + 19).EntireRow.Insert Range("B39:B58").EntireRow.Copy Range("A" & r) Application.ScreenUpdating = True End Sub
[/vba]
Как объединить работу этих двух макросов!?
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("Основная")) Is Nothing Then Set tb1_ = Sheets("Заключение").ListObjects("Основная7") With tb1_ nc_ = .ListColumns.Count nr_ = .ListRows.Count If nr_ Then .Range(1).Offset(1).Resize(nr_, nc_).Delete End If On Error Resume Next For i = 1 To nc_ Range("Основная[" & .Range(i) & "]").Copy .Range(nc_ + i) Next i On Error GoTo 0 End With End If End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
и терплю неудачу
