Всем привет. Столкнулся с неприятной особенностью "Умных" таблиц . Есть предельно простой макрос: [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] но хотелось бы без костылей обойтись -может что нужно отключить перед записью - искал не нашел.
Всем привет. Столкнулся с неприятной особенностью "Умных" таблиц . Есть предельно простой макрос: [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] но хотелось бы без костылей обойтись -может что нужно отключить перед записью - искал не нашел.SLAVICK
Доброй ночи если просто заполнить, то может быть просто[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]
Доброй ночи если просто заполнить, то может быть просто[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
неплохой вариант. Но придется массив разбивать на две части. У меня алгоритм немного сложнее. Есть база - со значениями (т.н. архив). Из нее извлекаются только значения в массив - потом этот массив сопоставляется с массивом формул таблицы- и заменяет все значения и если нужно формулу в какой-то ячейке на значения. я все сделал кроме выгрузки конечного массива в таблицу.(точнее и это сделал при помощи костыля как в 1-м посте.). Думал может есть свойство таблицы или листа типа Application.EnableEvents - только для таблицы.
неплохой вариант. Но придется массив разбивать на две части. У меня алгоритм немного сложнее. Есть база - со значениями (т.н. архив). Из нее извлекаются только значения в массив - потом этот массив сопоставляется с массивом формул таблицы- и заменяет все значения и если нужно формулу в какой-то ячейке на значения. я все сделал кроме выгрузки конечного массива в таблицу.(точнее и это сделал при помощи костыля как в 1-м посте.). Думал может есть свойство таблицы или листа типа Application.EnableEvents - только для таблицы.SLAVICK
Работает , только формулы стали массивные - ну это вроде не страшно. и все же интересно почему нет никакого "выключателя" для отключения автозамены значения на формулу
Работает , только формулы стали массивные - ну это вроде не страшно. и все же интересно почему нет никакого "выключателя" для отключения автозамены значения на формулуSLAVICK
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]
[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
хоть и короче в исполнении, и смотрятся изящнее - но можно использовать только в полностью своем проекте - где самому придется искать возможные несоответствия, к которым они могут привести. Спасибо еще раз всем за помощь .
RAN, убивать таблицу нельзя - все ссылки на колонки меняются. из вида :
Код
=СУММ(Куда[Сумма])
в
Код
=СУММ(Лист1!$K$5:$K$9)
к чему такое может привести - сложно сказать - тем более я делал лишь часть программы - поэтому точно менять существующие данные нельзя.
хоть и короче в исполнении, и смотрятся изящнее - но можно использовать только в полностью своем проекте - где самому придется искать возможные несоответствия, к которым они могут привести. Спасибо еще раз всем за помощь .SLAVICK
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]
Хорошая мысля приходит опосля. [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
Блиин - а мы были так близко уже krosav4ig, и предложил заполнять частями. Но чтобы добавить строку а потом ее же и грохнуть - не додумались . В этом вопросе RAN, Только я бы добавлял строку в конец и ее удалял бы: [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]
Блиин - а мы были так близко уже krosav4ig, и предложил заполнять частями. Но чтобы добавить строку а потом ее же и грохнуть - не додумались . В этом вопросе RAN, Только я бы добавлял строку в конец и ее удалял бы: [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]SLAVICK
То что она в xml хранится - понятно - так бы ей было не откуда возникать. . Вопрос можно ли ее найти в свойствах через ВБА, и там ее убить. Вечером, наверное дома посмотрю... Зы тему надо было в Мозговой штурм. Типа квест такой. .
То что она в xml хранится - понятно - так бы ей было не откуда возникать. . Вопрос можно ли ее найти в свойствах через ВБА, и там ее убить. Вечером, наверное дома посмотрю... Зы тему надо было в Мозговой штурм. Типа квест такой. .SLAVICK
Ага, костылем по причинному месту для файла из 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
Ага, костылем по причинному месту для файла из 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