Некорректная выгрузка массива в ListObjects...DataBodyRange

Дата: Понедельник, 10.04.2017, 23:15 | Сообщение № 1

Группа: Модераторы

Ранг: Старожил

Сообщений: 2290

Репутация: 766 ±

Замечаний: 0% ±

2019

Всем привет.
Столкнулся с неприятной особенностью "Умных" таблиц

.
Есть предельно простой макрос:
[vba]

Код

Sub d()
a = Sheets(1).ListObjects("Откуда").DataBodyRange.Formula
Sheets(1).ListObjects("Куда").DataBodyRange = a
End Sub

[/vba]
Который должен заполнять таблицу "Куда" - данными в точности как в таблице "Откуда".
Вроде и заполняет... но вот если в одном столбце есть и формулы и значения то формула столбца "съедает" значение - в примере красная ячейка.
Сразу скажу что эту болезнь обошел при помощи "костыля" и бубна в виде копирования в промежуточную таблицу.
Получился такой монстр:
[vba]

Код

Sub dD() 'Work
Dim pasteRange As Range, copyRange As Range
    a = Sheets(1).ListObjects("Откуда1").DataBodyRange.Formula
    Sheets(1).ListObjects("Куда1").DataBodyRange = a
With Sheets(1)
    Set copyRange = .ListObjects("Откуда1").DataBodyRange
        copyRange.Copy
    Set pasteRange = .[aa12].Resize(copyRange.Rows.Count, copyRange.Columns.Count)
        pasteRange.PasteSpecial Paste:=xlPasteAll
        pasteRange.SpecialCells(-4123, 23).ClearContents
        pasteRange.Copy
    .ListObjects("Куда1").DataBodyRange.PasteSpecial Paste:=xlPasteValues, SkipBlanks:=True
     pasteRange.Clear
End With
End Sub

[/vba]
но хотелось бы без костылей обойтись -может что нужно отключить перед записью - искал не нашел.

К сообщению приложен файл: Table_and_array.xlsm (22.7 Kb)

Иногда все проще чем кажется с первого взгляда.

Дата: Вторник, 11.04.2017, 02:32 | Сообщение № 2

Группа: Друзья

Ранг: Старожил

Сообщений: 2347

Репутация: 989 ±

Замечаний: 0% ±

Excel 2007,2010,2013

Доброй ночи
если просто заполнить, то может быть просто[vba]

Код

[Откуда].Copy [Куда]

[/vba] или [vba]

Код

[Откуда].Copy: [Куда].PasteSpecial -4123

[/vba]?
или такой костыль [vba]

Код

Dim a(1) As Variant
    With [Откуда]
        a(0) = .Resize(1).Formula
        a(1) = Intersect(.Cells, .Offset(1)).Formula
    End With
    With [Куда]
        Intersect(.Cells, .Offset(1)).Formula = a(1)
        .Resize(1).Formula = a(0)
    End With

[/vba]

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Вторник, 11.04.2017, 03:17

Дата: Вторник, 11.04.2017, 09:25 | Сообщение № 3

Группа: Модераторы

Ранг: Старожил

Сообщений: 2290

Репутация: 766 ±

Замечаний: 0% ±

2019

Цитата krosav4ig, 11.04.2017 в 02:32, в сообщении № 2 ()

если просто заполнить,

не первые варианты не подходят - там идет сдвиг формул, да и без .Copy - .Paste - нужно.
а

Цитата krosav4ig, 11.04.2017 в 02:32, в сообщении № 2 ()

такой костыль

неплохой вариант. Но придется массив разбивать на две части.
У меня алгоритм немного сложнее.
Есть база - со значениями (т.н. архив). Из нее извлекаются только значения в массив -
потом этот массив сопоставляется с массивом формул таблицы- и заменяет все значения и если нужно формулу в какой-то ячейке на значения.
я все сделал кроме выгрузки конечного массива в таблицу.(точнее и это сделал при помощи костыля как в 1-м посте.). Думал может есть свойство таблицы или листа типа
Application.EnableEvents - только для таблицы.

Иногда все проще чем кажется с первого взгляда.

Дата: Вторник, 11.04.2017, 09:28 | Сообщение № 4

Группа: Модераторы

Ранг: Старожил

Сообщений: 2290

Репутация: 766 ±

Замечаний: 0% ±

2019

Т.е. по сути у меня уже есть готовый массив данных (как в 1-м посте массив а) и его нужно просто выгрузить в таблицу заменив все ее значения.

Иногда все проще чем кажется с первого взгляда.

_Boroda_

Дата: Вторник, 11.04.2017, 09:51 | Сообщение № 5

Группа: Модераторы

Ранг: Местный житель

Сообщений: 16675

Репутация: 6481 ±

Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS

А вот такой вариант?
[vba]

Код

a = Sheets(1).ListObjects("Откуда").DataBodyRange.FormulaR1C1
Sheets(1).ListObjects("Куда").DataBodyRange.FormulaArray = a

[/vba]

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

Дата: Вторник, 11.04.2017, 11:58 | Сообщение № 6

Группа: Модераторы

Ранг: Старожил

Сообщений: 2290

Репутация: 766 ±

Замечаний: 0% ±

2019

Цитата _Boroda_, 11.04.2017 в 09:51, в сообщении № 5 ()

вот такой вариант?

Работает

, только формулы стали массивные - ну это вроде не страшно.
и все же интересно почему нет никакого "выключателя" для отключения автозамены значения на формулу

Иногда все проще чем кажется с первого взгляда.

RAN

Дата: Вторник, 11.04.2017, 14:02 | Сообщение № 7

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

[vba]

Код

Sub d()    'Work
    Set r = ActiveSheet.ListObjects("Куда").Range
    ActiveSheet.ListObjects("Куда").Unlist
    a = Sheets(1).ListObjects("Откуда").DataBodyRange.Formula
    r.Offset(1).Resize(UBound(a)) = a
    ActiveSheet.ListObjects.Add(xlSrcRange, r, , xlYes).Name = "Куда"
End Sub

[/vba]

Быть или не быть, вот в чем загвоздка!

Дата: Вторник, 11.04.2017, 15:31 | Сообщение № 8

Группа: Друзья

Ранг: Старожил

Сообщений: 2347

Репутация: 989 ±

Замечаний: 0% ±

Excel 2007,2010,2013

Цитата SLAVICK, 11.04.2017 в 11:58, в сообщении № 6 ()

нет никакого "выключателя"

ну он как бы есть, но в данном случае погоды не делает[vba]

Код

Application.AutoCorrect.AutoFillFormulasInLists=False

[/vba]

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Дата: Вторник, 11.04.2017, 20:21 | Сообщение № 9

Группа: Модераторы

Ранг: Старожил

Сообщений: 2290

Репутация: 766 ±

Замечаний: 0% ±

2019

RAN, убивать таблицу нельзя - все ссылки на колонки меняются.
из вида :

Код

=СУММ(Куда[Сумма])

Код

=СУММ(Лист1!$K$5:$K$9)

к чему такое может привести - сложно сказать - тем более я делал лишь часть программы - поэтому точно менять существующие данные нельзя.

Цитата krosav4ig, 11.04.2017 в 15:31, в сообщении № 8 ()

ну он как бы есть,

я его тоже пробовал - и не только его

, но так нужного свойства и не нашел.

Подведя выше предложенные варианты - не меняет структуру формул и таблицы мой костыль и

Цитата krosav4ig, 11.04.2017 в 02:32, в сообщении № 2 ()

такой костыль

Цитата _Boroda_, 11.04.2017 в 09:51, в сообщении № 5 ()

вот такой вариант

и вариант,

Цитата RAN, 11.04.2017 в 14:02, в сообщении № 7 ()

.Unlist

хоть и короче в исполнении, и смотрятся изящнее - но можно использовать только в полностью своем проекте - где самому придется искать возможные несоответствия, к которым они могут привести.
Спасибо еще раз всем за помощь

Иногда все проще чем кажется с первого взгляда.

RAN

Дата: Среда, 12.04.2017, 18:07 | Сообщение № 10

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

Хорошая мысля приходит опосля. yes

[vba]

Код

Sub d()
    a = Sheets(1).ListObjects("Откуда").DataBodyRange.Formula
    With Sheets(1).ListObjects("Куда")
        .ListRows.Add (2)
        .DataBodyRange.Offset(1).Resize(.ListRows.Count - 1, .ListColumns.Count).Value = a
        .ListRows(1).Delete
    End With
End Sub

[/vba]

Быть или не быть, вот в чем загвоздка!

Дата: Среда, 12.04.2017, 21:32 | Сообщение № 11

Группа: Модераторы

Ранг: Старожил

Сообщений: 2290

Репутация: 766 ±

Замечаний: 0% ±

2019

Цитата RAN, 12.04.2017 в 18:07, в сообщении № 10 ()

Хорошая мысля

Блиин - а мы были так близко уже krosav4ig, и предложил заполнять частями. Но чтобы добавить строку а потом ее же и грохнуть - не додумались

.
В этом вопросе RAN, first

Только я бы добавлял строку в конец и ее удалял бы:
[vba]

Код

Sub d()
    a = Sheets(1).ListObjects("Откуда").DataBodyRange.Formula
    With Sheets(1).ListObjects("Куда")
        .ListRows.Add
        .DataBodyRange.Resize(.ListRows.Count - 1, .ListColumns.Count).Value = a
        .ListRows(.ListRows.Count).Delete
    End With
End Sub

[/vba]
или немного короче:
[vba]

Код

Sub d()
    a = Sheets(1).ListObjects("Откуда").DataBodyRange.Formula
    With Sheets(1).ListObjects("Куда")
        .ListRows.Add
        .DataBodyRange.Resize(UBound(a)).Value = a
        .ListRows(.ListRows.Count).Delete
    End With
End Sub

[/vba]
[offtop]а куда делись названия "мяу"?[/offtop]

Иногда все проще чем кажется с первого взгляда.

RAN

Дата: Четверг, 13.04.2017, 08:51 | Сообщение № 12

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

Думаю, сей файлик внесет немного ясности

К сообщению приложен файл: 9169131.xlsm (17.1 Kb)

Быть или не быть, вот в чем загвоздка!

Дата: Четверг, 13.04.2017, 09:21 | Сообщение № 13

Группа: Модераторы

Ранг: Старожил

Сообщений: 2290

Репутация: 766 ±

Замечаний: 0% ±

2019

Цитата RAN, 13.04.2017 в 08:51, в сообщении № 12 ()

сей файлик

Вызвал у меня когнитивный диссонанс.

.
откуда "восстает" формула? - значит, она же должна где-то сохранятся - вопрос где?

Иногда все проще чем кажется с первого взгляда.

Дата: Четверг, 13.04.2017, 12:21 | Сообщение № 14

Группа: Друзья

Ранг: Старожил

Сообщений: 2347

Репутация: 989 ±

Замечаний: 0% ±

Excel 2007,2010,2013

Цитата SLAVICK, 13.04.2017 в 09:21, в сообщении № 13 ()

где-то сохранятся - вопрос где?

\xl\tables\table1.xml

Цитата

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<table xmlns="http://schemas.openxmlformats.org/spreadsheetml/2006/main" id="1" name="Таблица1" displayName="Таблица1" ref="A1:B2" totalsRowShown="0">
    <autoFilter ref="A1:B2" />
    <tableColumns count="2">
        <tableColumn id="1" name="Столбец1" />
        <tableColumn id="2" name="Столбец2">
                <calculatedColumnFormula>SMALL($G$8:$G$10,1)</calculatedColumnFormula>
        </tableColumn>
    </tableColumns>
    <tableStyleInfo name="TableStyleMedium2" showFirstColumn="0" showLastColumn="0" showRowStripes="1" showColumnStripes="0" />
</table>

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Четверг, 13.04.2017, 12:23

Дата: Четверг, 13.04.2017, 15:05 | Сообщение № 15

Группа: Модераторы

Ранг: Старожил

Сообщений: 2290

Репутация: 766 ±

Замечаний: 0% ±

2019

Цитата krosav4ig, 13.04.2017 в 12:21, в сообщении № 14 ()

\xl\tables\

То что она в xml хранится - понятно - так бы ей было не откуда возникать.

.
Вопрос можно ли ее найти в свойствах через ВБА, и там ее убить.
Вечером, наверное дома посмотрю...
Зы тему надо было в Мозговой штурм. Типа квест такой.

Иногда все проще чем кажется с первого взгляда.

Дата: Четверг, 13.04.2017, 19:07 | Сообщение № 16

Группа: Друзья

Ранг: Старожил

Сообщений: 2347

Репутация: 989 ±

Замечаний: 0% ±

Excel 2007,2010,2013

Цитата SLAVICK, 13.04.2017 в 15:05, в сообщении № 15 ()

и там ее убить.

Ага, костылем по причинному месту

для файла из 12 поста
[vba]

Код

Sub dd()
    Dim a As Variant
    With [Таблица1].ListObject
        .ListRows.Add 1
        With .ListColumns("Столбец2").DataBodyRange
            .Cells(1).Clear
            .Formula = .Formula
        End With
        .ListRows(1).Delete
    End With
End Sub

[/vba]

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Четверг, 13.04.2017, 19:09