Добрый день еще раз всем!!! Можно ли связать две таблицы!? На листе В25 имеется таблица "основная" (с возможным увеличением количества строк для расчетов) На втором листе "Заключение" данная таблица должна будет дублироваться (данный лист будет доступен лишь для печати - там много еще будет информации) Как можно было бы сделать взаимосвязь этих таблиц Спасибо ОГРОМНОЕ заранее за помощь и подсказки
Добрый день еще раз всем!!! Можно ли связать две таблицы!? На листе В25 имеется таблица "основная" (с возможным увеличением количества строк для расчетов) На втором листе "Заключение" данная таблица должна будет дублироваться (данный лист будет доступен лишь для печати - там много еще будет информации) Как можно было бы сделать взаимосвязь этих таблиц Спасибо ОГРОМНОЕ заранее за помощь и подсказкиanisimovaleksandr32
Админ прошу прощение а можно данную тему в макросы перенести... Как я понял формулами можно но не так как нужно Разыскал код, может на другой ветке помогут его подправить
Админ прошу прощение а можно данную тему в макросы перенести... Как я понял формулами можно но не так как нужно Разыскал код, может на другой ветке помогут его подправить
Помогите пжл дополнить усовершенствовать его: Если вдруг оператор увеличил количество строк "основную таблицу" Или же уменьшил количество строк в "основной таблице" Если дополнять строки или удалять их в центре основной таблицы то по сути данный код срабатывает
Помогите пжл дополнить усовершенствовать его: Если вдруг оператор увеличил количество строк "основную таблицу" Или же уменьшил количество строк в "основной таблице" Если дополнять строки или удалять их в центре основной таблицы то по сути данный код срабатывает
китин, спасибо за ответ - все разобрался - получилось Он и без определения последней строки получается срабатывает (просто в файлах потерялся и не туда или не так смотрел - не внимательный, факт)
Но проблема заключается на другом листе Потому как под этой таблицей имеется другая информация А при срабатывании макроса данное копирование накладывается на эту информацию Я так понимаю тут нужно что то другое
Да и копирование происходит с формулами - нужно кумекать (в моем случае искать аналогичное решение. потому как с этим vba я не в ладах)
И вот если основную таблицу еще увеличить то на другом листе где в ячейке X52 слово ПРИМЕЧАНИЕ код сработает на ура но и слово примечание удалиться
китин, спасибо за ответ - все разобрался - получилось Он и без определения последней строки получается срабатывает (просто в файлах потерялся и не туда или не так смотрел - не внимательный, факт)
Но проблема заключается на другом листе Потому как под этой таблицей имеется другая информация А при срабатывании макроса данное копирование накладывается на эту информацию Я так понимаю тут нужно что то другое
Да и копирование происходит с формулами - нужно кумекать (в моем случае искать аналогичное решение. потому как с этим vba я не в ладах)
И вот если основную таблицу еще увеличить то на другом листе где в ячейке X52 слово ПРИМЕЧАНИЕ код сработает на ура но и слово примечание удалитьсяanisimovaleksandr32
Нашел свою старую тему и в ней _Boroda_, Как то прописывал вот такой вот код:
PrivateSub Worksheet_Change(ByVal Target As Range) IfNot Intersect(Target, Range("Основная")) IsNothingThen Set tb1_ = Sheets("Заключение").ListObjects("Основная7") With tb1_
nc_ = .ListColumns.Count
nr_ = .ListRows.Count If nr_ Then
.Range(1).Offset(1).Resize(nr_, nc_).Delete EndIf OnErrorResumeNext For i = 1To nc_
Range("Основная[" & .Range(i) & "]").Copy .Range(nc_ + i) Next i OnErrorGoTo0 EndWith EndIf EndSub
Тоже работает на УРА!!! Но вот как избежать удаления (наложения на другую информацию к примеру в ячейке X52 и последующие ниже ) как добиться кодом чтоб таблица не накладывалась на нее А также копирование происходило без формул
Нашел свою старую тему и в ней _Boroda_, Как то прописывал вот такой вот код:
PrivateSub Worksheet_Change(ByVal Target As Range) IfNot Intersect(Target, Range("Основная")) IsNothingThen Set tb1_ = Sheets("Заключение").ListObjects("Основная7") With tb1_
nc_ = .ListColumns.Count
nr_ = .ListRows.Count If nr_ Then
.Range(1).Offset(1).Resize(nr_, nc_).Delete EndIf OnErrorResumeNext For i = 1To nc_
Range("Основная[" & .Range(i) & "]").Copy .Range(nc_ + i) Next i OnErrorGoTo0 EndWith EndIf EndSub
Тоже работает на УРА!!! Но вот как избежать удаления (наложения на другую информацию к примеру в ячейке X52 и последующие ниже ) как добиться кодом чтоб таблица не накладывалась на нее А также копирование происходило без формулanisimovaleksandr32
Сообщение отредактировал anisimovaleksandr32 - Четверг, 10.03.2022, 13:30
МНОГОУВАЖАЕМЫЕ ФОРУМЧАНЕ!!! Помогите пожалуйста дополнить макрос выше вот таким вот действием Когда то был рассмотрен пример: My WebPage В данном примере учитывалось условие и работа макроса через кнопку: копирование строк и вставка этих строк до "Примечания"
PublicSub 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 EndSub
Как объединить работу этих двух макросов!?
PrivateSub Worksheet_Change(ByVal Target As Range) IfNot Intersect(Target, Range("Основная")) IsNothingThen Set tb1_ = Sheets("Заключение").ListObjects("Основная7") With tb1_
nc_ = .ListColumns.Count
nr_ = .ListRows.Count If nr_ Then
.Range(1).Offset(1).Resize(nr_, nc_).Delete EndIf OnErrorResumeNext For i = 1To nc_
Range("Основная[" & .Range(i) & "]").Copy .Range(nc_ + i) Next i OnErrorGoTo0 EndWith EndIf EndSub
МНОГОУВАЖАЕМЫЕ ФОРУМЧАНЕ!!! Помогите пожалуйста дополнить макрос выше вот таким вот действием Когда то был рассмотрен пример: My WebPage В данном примере учитывалось условие и работа макроса через кнопку: копирование строк и вставка этих строк до "Примечания"
PublicSub 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 EndSub
Как объединить работу этих двух макросов!?
PrivateSub Worksheet_Change(ByVal Target As Range) IfNot Intersect(Target, Range("Основная")) IsNothingThen Set tb1_ = Sheets("Заключение").ListObjects("Основная7") With tb1_
nc_ = .ListColumns.Count
nr_ = .ListRows.Count If nr_ Then
.Range(1).Offset(1).Resize(nr_, nc_).Delete EndIf OnErrorResumeNext For i = 1To nc_
Range("Основная[" & .Range(i) & "]").Copy .Range(nc_ + i) Next i OnErrorGoTo0 EndWith EndIf EndSub