Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Копировать столбец умной таблицы в другую умную таблицу vba
 
#1
09.06.2022 16:48:51
Добрый день! 3 вопроса:
1. Необходимо копировать (или присвоить) значения из одной умной таблицы в другую (столбец целиком). Как это сделать?
2. Можно ли копировать умную таблицу целиком в другую умную таблицу, заменив формулы значениями, если вторая умная таблица содержит те же столбцы, что и первая, но между ними есть еще другие столбцы?
3. Можно ли второй вопрос реализовать без помощи макросов, но чтобы связь между двумя таблицами была жесткая и значения из дополнительных столбцов точно не могли никуда поехать при подгрузке данных из первой таблицы?
 
 
 
#2
09.06.2022 16:59:31
Код
Sub CopyListObjectsColumn()
    Dim tb1 As ListObject
    Set tb1 = ActiveSheet.ListObjects(1)
    
    Dim tb2 As ListObject
    Set tb2 = ActiveSheet.ListObjects(2)
    
    Dim arr As Variant
    
    Dim colName As Variant
    For Each colName In Array("a", "d")
        arr = tb1.ListColumns(colName).DataBodyRange
        tb2.ListColumns(colName).DataBodyRange.Resize(tb1.ListColumns(colName).DataBodyRange.Rows.Count, 1).Value = arr
    Next
End Sub
 
 
 
#3
09.06.2022 17:01:53
Цитата
написал:
Можно ли второй вопрос реализовать без помощи макросов, но чтобы связь между двумя таблицами была
Код
=СМЕЩ(Таблица1[[#Заголовки];[a]];СТРОКА(A1);0)
 
 
 
#4
09.06.2022 17:16:15
Цитата
написал:
=СМЕЩ(Таблица1[[#Заголовки];[a]];СТРОКА(A1);0)
А если таблицы в разных книгах, оно нормально будет работать?
 
 
 
#5
09.06.2022 17:18:56
Цитата
написал:
   For Each colName In Array("a", "d")
       arr = tb1.ListColumns(colName).DataBodyRange
       tb2.ListColumns(colName).DataBodyRange.Resize(tb1.ListColumns(colName).DataBodyRange.Rows.Count, 1).Value = arr
   Next
Поясните, пожалуйста, что здесь происходит)
Изменено: Елена Дроздова - 09.06.2022 17:19:27
 
 
 
#6
09.06.2022 17:19:18
.
Изменено: _Igor_61 - 09.06.2022 17:21:38
 
 
 
#7
09.06.2022 17:20:57
Цитата
написал:
оно нормально будет работать?
Время ожидания ответа с форума заведомо больше, чем время эксперимента )
 
 
 
#8
09.06.2022 17:21:36
Цитата
написал:
Время ожидания ответа с форума заведомо больше, чем время эксперимента )
На обнаружение ошибки иногда и недели уходят))
 
 
 
#9
09.06.2022 17:24:34
Цитата
.
Изменено: Елена Дроздова - 09.06.2022 17:25:46
 
 
 
#10
09.06.2022 17:56:07
Код
Sub CopyListObjectsColumn()
    Dim tb1 As ListObject
    Set tb1 = Workbooks("Реестр Претензионного отдела").Sheets("РЕЕСТР").ListObjects("Таблица4")
     
    Dim tb2 As ListObject
    Set tb2 = Workbooks("Портянка").Sheets("Лист1").ListObjects("Таблица1")
     
    Dim arr As Variant
     
    Dim colName As Variant
    For Each colName In Array("№п/п", "ЖК", "Корпус", "Тип помещения", "Номер помещения", "Отделка", "Этап получения замечания", "Дата обращения", "Общий статус обращения", "Замечание клиента", "Статус замечания", "Исполнитель", "Время устранения", "Статус ТМЦ", "Статус материалов", "Комментарии", "Столбец1")
        arr = tb1.ListColumns(colName).DataBodyRange 
        tb2.ListColumns(colName).DataBodyRange.Resize(tb1.ListColumns(colName).DataBodyRange.Rows.Count, 1).Value = arr
    Next
End Sub
Строка
Код
arr = tb1.ListColumns(colName).DataBodyRange
Выдает ошибку 9. Почему?
 
 
 
#11
09.06.2022 19:50:14
В таблице
Код
 Workbooks("Реестр Претензионного отдела").Sheets("РЕЕСТР").ListObjects("Таблица4")
нет элемента из массива "№п/п", "ЖК", "Корпус", "Тип помещения", "Номер помещения", "Отделка", "Этап получения замечания", "Дата обращения", "Общий статус обращения", "Замечание клиента", "Статус замечания", "Исполнитель", "Время устранения", "Статус ТМЦ", "Статус материалов", "Комментарии", "Столбец1"
 
 
 
#12
10.06.2022 10:19:03
Почему нет-то? Вот же они
 
 
 
#13
10.06.2022 10:29:28
Код
Sub CopyListObjectsColumn()
    Dim tb1 As ListObject
    Set tb1 = Workbooks("Реестр Претензионного отдела.xlsm").Sheets("РЕЕСТР").ListObjects("Таблица4")
      
    Dim tb2 As ListObject
    Set tb2 = Workbooks("Портянка.xlsm").Sheets("Лист1").ListObjects("Таблица1")
      
    Dim arr As Variant
      
    Dim colName As Variant
    On Error Resume Next
    For Each colName In Array("№п/п", "ЖК", "Корпус", "Тип помещения", "Номер помещения", "Отделка", "Этап получения замечания", "Дата обращения", "Общий статус обращения", "Замечание клиента", "Статус замечания", "Исполнитель", "Время устранения", "Статус ТМЦ", "Статус материалов", "Комментарии", "Столбец1")
        arr = tb1.ListColumns(colName).DataBodyRange
        tb2.ListColumns(colName).DataBodyRange.Resize(tb1.ListColumns(colName).DataBodyRange.Rows.Count, 1).Value = arr
        If Err Then
            MsgBox "Проверьте столбец " & colName, vbCritical
            Exit For
        End If
    Next
    On Error GoTo 0
End Sub
Странно, что макрос до строки 9 дошёл. В третьей строке не указано расширение файла.
 
 
 
#14
10.06.2022 10:40:19

Все равно на 13 строке вылетает

Изменено: Елена Дроздова - 10.06.2022 10:47:40
 
 
 
#15
10.06.2022 10:51:06
Дурацкая ошибка, пробел пропустила.

Из 13 сообщения 14 строка вылетает теперь с ошибкой 91
 
 
 
#16
10.06.2022 11:48:04
Все получилось, спасибо за помощь
 
 
 
Страницы: 1
Наверх