Копирование формул без сдвига ссылок
Проблема
Предположим, что у нас есть вот такая несложная таблица, в которой подсчитываются суммы по каждому месяцу в двух городах, а затем итог переводится в евро по курсу из желтой ячейки J2.
Проблема в том, что если скопировать диапазон D2:D8 с формулами куда-нибудь в другое место на лист, то Microsoft Excel автоматически скорректирует ссылки в этих формулах, сдвинув их на новое место и перестав считать:
Задача: скопировать диапазон с формулами так, чтобы формулы не изменились и остались теми же самыми, сохранив результаты расчета.
Способ 1. Абсолютные ссылки
Способ 2. Временная деактивация формул
Чтобы формулы при копировании не менялись, надо (временно) сделать так, чтобы Excel перестал их рассматривать как формулы. Это можно сделать, заменив на время копирования знак "равно" (=) на любой другой символ, не встречающийся обычно в формулах, например на "решетку" (#) или на пару амперсандов (&&). Для этого:
- Выделяем диапазон с формулами (в нашем примере D2:D8)
- Жмем Ctrl+H на клавиатуре или на вкладке Главная - Найти и выделить - Заменить (Home - Find&Select - Replace)
- В появившемся диалоговом окне вводим что ищем и на что заменяем и в Параметрах (Options) не забываем уточнить Область поиска - Формулы. Жмем Заменить все (Replace all).
- Копируем получившийся диапазон с деактивированными формулами в нужное место:
- Заменяем # на = обратно с помощью того же окна, возвращая функциональность формулам.
Способ 3. Копирование через Блокнот
Этот способ существенно быстрее и проще.
Нажмите сочетание клавиш Ctrl+Ё или кнопку Показать формулы на вкладке Формулы (Formulas - Show formulas), чтобы включить режим проверки формул - в ячейках вместо результатов начнут отображаться формулы, по которым они посчитаны:
Скопируйте наш диапазон D2:D8 и вставьте его в стандартный Блокнот:
Теперь выделите все вставленное (Ctrl+A), скопируйте в буфер еще раз (Ctrl+C) и вставьте на лист в нужное вам место:
Осталось только отжать кнопку Показать формулы (Show Formulas), чтобы вернуть Excel в обычный режим.
Примечание: этот способ иногда дает сбой на сложных таблицах с объединенными ячейками, но в подавляющем большинстве случаев - работает отлично.
Способ 4. Макрос
Если подобное копирование формул без сдвига ссылок вам приходится делать часто, то имеет смысл использовать для этого макрос. Нажмите сочетание клавиш Alt+F11 или кнопку Visual Basic на вкладке Разработчик (Developer), вставьте новый модуль через меню Insert - Module и скопируйте туда текст вот такого макроса:
Sub Copy_Formulas()
Dim copyRange As Range, pasteRange As Range
On Error Resume Next
Set copyRange = Application.InputBox("Выделите ячейки с формулами, которые надо скопировать.", _
"Точное копирование формул", Default:=Selection.Address, Type:=8)
If copyRange Is Nothing Then Exit Sub
Set pasteRange = Application.InputBox("Теперь выделите диапазон вставки." & vbCrLf & vbCrLf & _
"Диапазон должен быть равен по размеру исходному " & vbCrLf & _
"диапазону копируемых ячеек.", "Точное копирование формул", _
Default:=Selection.Address, Type:=8)
If pasteRange.Cells.Count <> copyRange.Cells.Count Then
MsgBox "Диапазоны копирования и вставки разного размера!", vbExclamation, "Ошибка копирования"
Exit Sub
End If
If pasteRange Is Nothing Then
Exit Sub
Else
pasteRange.Formula = copyRange.Formula
End If
End Sub
Для запуска макроса можно воспользоваться кнопкой Макросы на вкладке Разработчик (Developer - Macros) или сочетанием клавиш Alt+F8. После запуска макрос попросит вас выделить диапазон с исходными формулами и диапазон вставки и произведет точное копирование формул автоматически:
Ссылки по теме
- Удобный просмотр формул и результатов одновременно
- Зачем нужен стиль ссылок R1C1 в формулах Excel
- Как быстро найти все ячейки с формулами
- Инструмент для точного копирования формул из надстройки PLEX
Sub Copy_Formulas()
Dim copyRange As Range, pasteRange As Range On Error Resume Next Set copyRange = Application.InputBox("Выделите ячейки с формулами, которые нужно скопировать", _ "Точное копирование формул", Default:=Selection.Address, Type:=8 If copyRange Is Nothing Then Exit Sub 'подсчет строк и столбцов копируемого диапазона copyrangerows = copyRange.Cells.Rows.Count copyrangecols = copyRange.Cells.Columns.Count Set pasteRange = Application.InputBox("Выделите первую ячейку для вставки формул", "Точное копирование формул" Default:=Selection.Address, Type:=8 If pasteRange Is Nothing Then Exit Sub Else 'изменение диапазона вставки Set pasteRange = pasteRange.Resize(copyrangerows, copyrangecols) pasteRange.Formula = copyRange.Formula End If End SubСкопировать в строке формул формулу из D2 и вставить её в G2, после чего "протянуть" вниз
Так же можно просто дать ссылку в G2 на D2
Или сразу сослаться в G2:G8 формулой массива, введённой сразу во все ячейки =D2:D8?
Или "перетянув" D2:D8 в G2:G8 с зажатой ПКМ выбрать "Связать"?
И когда делаешь "связать", то формула не копируется, а делается ссылка на исходные ячейки.
Верно, но результат-то получается такой же как и при копировании формул
Ужасно неудобно, хотя, конечно, тоже способ
1) копирую нужный столбец в произвольные ячейки (формулы пересчитываются)
2) вырезаю нужный столбец и вставляю его в "пункт назначения"
3) скопированные ранее ячейки копирую в начальный диапозон (все возвращается на свои места)
А как заставить данный макрос работать при копировании формул между книгами?
Маленькое замечание: у меня ошибка возникает, когда запускаю данный макрос (ошибка в синтаксе). Убрал <br> в конце (т.е. оставил только End Sub) и макрос заработал. В видео правильный макрос, а в тексте <br>.
(СЖПРОБЕЛЫ)
1.все получаетса, но мне нужен текст , а не формулы . когда я копирую формулу и вставляю спец . вставкой "значения" пробелы возвращаютса,что делать?
Тот же самый эффект будет через "вырезать-вставить"...
Лечится просто вот готовый код (протестирован) -- >
Sub Copy_Formulas() 'Копирование формул без сдвига ссылок Умное копирование Dim copyRange As Range, pasteRange As Range Dim copyrangerows As String, copyrangecols As String Dim RfStyle As String RfStyle = Application.ReferenceStyle ' запоминаем стиль ссылок If Application.ReferenceStyle = xlR1C1 Then Application.ReferenceStyle = xlA1 ' меняем стиль ссылок на "А1" On Error Resume Next Set copyRange = Application.InputBox("Выделите ячейки с формулами, которые нужно скопировать", _ "Точное копирование формул", Default:=Selection.Address, Type:=8) If copyRange Is Nothing Then Exit Sub 'подсчет строк и столбцов копируемого диапазона copyrangerows = copyRange.Cells.Rows.Count copyrangecols = copyRange.Cells.Columns.Count Set pasteRange = Application.InputBox("Выделите первую ячейку для вставки формул", "Точное копирование формул", _ Default:=Selection.Address, Type:=8) If pasteRange Is Nothing Then Exit Sub Else 'изменение диапазона вставки Set pasteRange = pasteRange.Resize(copyrangerows, copyrangecols) pasteRange.Formula = copyRange.Formula End If Application.ReferenceStyle = RfStyle ' возвращаем стиль ссылок на исходный End SubВозможно нечто подобное, т.е. точное копирование формул с последующей вставкой в отфильтрованные строки?
Пробовал ваш, Макрос вставки любых значений, но всталяет уже значения после вычисления:(
Пользуюсь заменой на решетку туда-обратно в выбранном диапазоне - быстро и очень удобно ) Доволен аки слон )
Код вида (1):
Копирует формулу без сдвига.
Код вида (2):
Как раз обеспечивает сдвиг.
Но! Есть огромное НО!!! Огромнейшее!
Скорость этого макроса становится в разы медленнее.
Сравнивал на рабочих данных в 1000 строк с несколькими замерами. В среднем код (2) - 29 секунд, код (1) - 0.125.
Разница в 232 раза. Код (2) использует буфер.
И снова вопрос, как воспользоваться преимуществом кода (1), но со сдвигом?
Заранее спасибо за ответ!
Код (1) просто меняется на такой, где добавляется указание на тип ссылок R1C1:
Код вида (1м):
Ссылки становятся относительными/со сдвигом.
Проверил еще раз на рабочих данных увеличив (копированием) до 5000 строк.
В среднем выполнялся код вида (2) - 165 секунд, код вида (1м) - 1.01. Разница в 165 раз.
А это рабочий код, который нужно было сделать:
Sub КопирФормулуСумм() Dim Cell As Range Dim LastRow As Long Dim MyRange As Range Const FirstRow As Long = 4 LastRow = Cells(Rows.Count, 1).End(xlUp).Row Set MyRange = Range("K" & FirstRow, "K" & LastRow) Application.ScreenUpdating = False For Each Cell In MyRange.Cells If Cell.Interior.ColorIndex = 24 Then 'игрался со способом в блоке 1 либо 2 ' блок 1 медленный ' Cell.Copy ' Range("O" & Cell.Row).PasteSpecial xlPasteFormulas ' Range("R" & Cell.Row).PasteSpecial xlPasteFormulas ' блок 2 быстрый Range("O" & Cell.Row).FormulaR1C1 = Cell.FormulaR1C1 Range("R" & Cell.Row).FormulaR1C1 = Cell.FormulaR1C1 Range("O" & Cell.Row).Interior.Color = Cell.Interior.Color Range("R" & Cell.Row).Interior.Color = Cell.Interior.Color Application.CutCopyMode = False Else End If Next Cell Application.ScreenUpdating = True End Sub