Всем доброго дня!
Excel 2007
Есть необходимость программно скопировать формулу из верхней ячейки в следующую пустую одного и того же столбца.
Событие происходит не в модуле, а на листе (Private Sub Worksheet_Change(ByVal Target As Range))
Что делаю:
1. Объявляю переменные
Dim a
Dim b
2. Нахожу последнюю пустую строку
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
3. Выбираю со смещением нужную мне ячейку, где уже есть формула.
Cells(LastRow — 0, 6).Select
4. Загоняю формулу в переменную а
a = Cells(LastRow — 0, 6).Formula
Если посмотреть «а», то моя формула там сохранена в виде строки типа «=бла бла бла»
5. Выбираю следующую вниз пустую ячейку, чтоб скопировать формулу из переменной «а»
ActiveCell.Offset(1, 0).Select
И тут загвоздка.
Метод copy paste не работает, ошибка Object required
Назначение переменной «а» в качестве as Range почему-то не работает или я туплю (начал хорошо отмечать праздник…)
Вопрос: как скопировать формулу?
I have an existing VBA code that copies an Excel worksheet from my source workbook (Sourcewb) into a new destination workbook (Destwb) but pastes values only. I need a specific range (D31:E38) in the Destwb to include the formulas from the source workbook. I found this code:
Range("A1:I1105").Copy Sheets("Sheet2").Range("B2")
On this site (another question) that seems related but don’t know how to modify it to work in my application. I have added a comment line » ‘Insert total formulas in Calc sheet» for where I think the additional code would go. Here is my existing code:
Set Sourcewb = ActiveWorkbook
'Copy the sheet to a new workbook
Sheets("Calculation").Copy
Set Destwb = ActiveWorkbook
'Determine the Excel version and file extension/format
With Destwb
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2013
FileExtStr = ".xlsx": FileFormatNum = 51
End If
End With
'Change all cells in the worksheet to values if you want
With Destwb.Sheets(1).UsedRange
Application.CutCopyMode = False
ActiveSheet.Unprotect
.Cells.Copy
.Cells.PasteSpecial xlPasteValues
.Cells(1).Select
End With
Application.CutCopyMode = False
'Insert total formulas in Calc sheet
'Save the new workbook and close it
TempFilePath = Sheets("Calculation").Range("L4").Value
TempFileName = Range("L3").Value
With Destwb
.SaveAs TempFilePath & "" & TempFileName & FileExtStr, FileFormat:=FileFormatNum
.Close SaveChanges:=True
End With
MsgBox "You can find the new file in " & TempFilePath
shA.t
16.4k5 gold badges53 silver badges111 bronze badges
asked May 12, 2015 at 15:08
1
You could copy the whole thing first, like you are doing and then overwrite the cells in Destwb D31:E38 with the formulas from the cells in Sourcewb. Assuming the range of interest in Sourcewb is «D31:E38» and that the destination range and source range are the same size, you could do the following:
'Copy all cells
'Your code here
'New code
set formulaRngFromSource = Sourcewb.Sheets("Calculation").Range("D31:E38")
set formulaRngToDest = Destwb.Sheets(1).Range("D31:E38")
i = 1
for each range in formulaRngFromSource
formulaRngToDest(i).Formula = range.Formula
i = i + 1
next range
shA.t
16.4k5 gold badges53 silver badges111 bronze badges
answered May 12, 2015 at 15:28
deasadeasa
60610 silver badges24 bronze badges
0
You can try with: ActiveSheet.PasteSpecial Paste:=xlFormulas
ActiveSheet.Unprotect
...
.Cells.Copy
.Cells.PasteSpecial xlPasteValues
.Cells.PasteSpecial xlFormulas
.Cells(1).Select
End With
shA.t
16.4k5 gold badges53 silver badges111 bronze badges
answered May 12, 2015 at 15:21
JavyskJavysk
3512 silver badges16 bronze badges
VBA, как быстро скопировать формулу и форматирование ячейки?
[Последний вывод] Я обнаружил, что value(11) может иногда копировать формулы, но не всегда. Формулы типа sumproduct и sumif не могут быть скопированы, но простые арифметические операции могут быть скопированы. Это так странно! Я до сих пор не могу понять, почему.
Я знаю, что если я хочу только копировать значения, самый быстрый способ –
Если я хочу скопировать форматирование и значения, самый быстрый способ –
Если я хочу скопировать формулы, самый быстрый способ –
Что делать, если я хочу скопировать формулу и форматирование? (У меня много форматирования в этой ячейке, как условное форматирование, полужирное, подчеркивание, выравнивание, формат отображения номера, стиль границы и т.д., Поэтому нецелесообразно передавать каждый из стилей по одному.)
Я просто нашел простой ответ.
Так как value(11) терпит неудачу при копировании некоторых сложных формул (я не знаю, почему, должно быть, ошибка в Excel), я добавил вторую строку, чтобы снова вставить формулу. Это должно гарантировать правильность копирования всех формул.
Как о суб подобном:
Все, что он делает, – это то, что вы показали в вопросе (полезно знать о .value(11)!) в цикле для заданного диапазона.
Чтобы скопировать формулы с форматированием в исходном диапазоне и сохранить относительные формулы (например, как с помощью Ctr-C и Ctr-V), используйте этот метод копирования и вставки:
Источник
Excel копировать формулы vba
= Мир MS Excel/Перенос формул в макрос — Мир MS Excel
Войти через uID
Войти через uID
Модератор форума: _Boroda_, китин
Мир MS Excel » Вопросы и решения » Готовые решения » Перенос формул в макрос (Excel)
Перенос формул в макрос
| anisimovaleksandr32 | Дата: Понедельник, 25.01.2021, 12:44 | Сообщение № 1 | ||||||||||||||||||||||||||||||||||||||||||||||||||||
|
|
Группа: Пользователи Ранг: Новичок Сообщений: 45
Замечаний: |
Здравствуйте, может мой вопрос уже изъезжен, но не могу найти решение.
Необходимо скопировать формулу из ячейки одного документа в ячейку другого документа.
Опишу кратко, код там большой но все упирается в следующий отрезок.
Допустим в ячейке есть формула A1+B1
[vba]
Код
Set WS1 = Workbooks.Item(«Договоры1.xlsm»).Sheets(«Договоры»)
Set WS2 = Workbooks.Item(«Договоры2.xlsm»).Sheets(«Договоры»)
WS1.Cells(1, 2).Copy: WS2.Cells(1, 2).PasteSpecial xlPasteValues ‘Копирую значения
WS1.Cells(1, 2).Copy: WS2.Cells(1, 2).PasteSpecial xlPasteFormulas ‘Копирую формулы
[/vba]
В итоге в файл «Договоры2» копируется ячейка, а формула в ней ссылается на ячейки файла «Договоры1»
с результатом ‘C:…Договоры1′!A1+C:…Договоры1’!B1
Как быть? нужно чтобы получилось A1+B1
Я так понимаю можно какой то приписать параметр может быть?
#excel #vba #excel-formula #excel-365
Вопрос:
Итак, у меня есть рабочая тетрадь, которую я настраивал так:
Снимок экрана рабочей книги (ячейка с 2 в ней-это я вручную вставляю формулу в эту ячейку)
Другой снимок экрана с только что рассчитанной формулой и пустой ячейкой под ней
- В принципе, на одном конце листа у меня есть формула для редактирования значения ячейки на другом конце строки, в которой она находится, в зависимости от того, есть ли данные в соседних ячейках с целевой ячейкой в этой строке.
- Если данных нет, он автоматически заполняет целевую ячейку, а также ячейку непосредственно под ячейкой формулы.
До сих пор мне удавалось разобраться во всем этом самостоятельно, но я не могу понять, как реализовать то, что я хочу сделать дальше:
- После того, как формула увидит, что в строке есть данные, и отредактирует целевую ячейку, я также хочу, чтобы она скопировала саму формулу в ячейку непосредственно под ней (поэтому убедитесь, что каждая строка имеет эту функциональность по мере заполнения).
Я пытался создать функцию в vba, которая делает это, но мне трудно понять, как это сделать. Я пытался использовать такие вещи, как [formulaCell].FormulaLocal и PasteSpecial и тому подобное, но, хотя иногда мне удавалось успешно копировать формулу, она всегда либо использует абсолютные ссылки, либо относительные ссылки, которые не меняются (т. Е. Если целевая ячейка равна $A2 в исходной формуле, целевая ячейка по-прежнему равна $A2 в вставленной формуле, и ячейка, на которую она ссылается, не меняется. Я хочу, чтобы он вставлялся как ячейка $A3, так как он вставляется в строку 3 здесь.)
Вот весь пользовательский код, который я написал в этом модуле (и полностью в рабочей книге):
Function CopyCellContents2(copyFrom As Range, CopyTo As Range) ' reference only, I don't use this in the function copyFrom.Parent.Evaluate "CopyOver2(" amp; copyFrom.Address(False, False) _ amp; "," amp; CopyTo.Address(False, False) amp; ")" CopyCellContents2 = "1" End Function ' (can you tell i copy-pasted from an online tutorial lol) Private Sub CopyOver2(copyFrom As Range, CopyTo As Range) ' same as above function CopyTo.Value = copyFrom.Value End Sub Function CopyFormulaDown(copy__From As Range) ' This is the function that I can't make work copy__From.Parent.Evaluate "CopyForm(" amp; copy__From.Address(False, False) _ amp; ")" CopyFormulaDown = "1" End Function Private Sub CopyForm(copy__From As Range) ' Same as above startAddress = ActiveCell.Address ActiveCell.Address = copy__From.Address(False, False) ActiveCell.Select Selection.copy ActiveCell.Offset(1, 0).Range("A1").Select ActiveSheet.Paste ActiveCell.Address = startAddress ActiveCell.Select Application.CutCopyMode = False End Sub Function StaticDate(Copy_To As Range) ' This works well Copy_To.Parent.Evaluate "CopyDate(" _ amp; Copy_To.Address(False, False) amp; ")" StaticDate = "1" End Function Private Sub CopyDate(Copy_To As Range) ' Same as above Copy_To.Value = Int(Now()) End Sub Function BlankOtherCell(BlankedCell As Range) ' This also works how I want it to BlankedCell.Parent.Evaluate "CellBlank(" _ amp; BlankedCell.Address(False, False) amp; ")" BlankOtherCell = "1" End Function Private Sub CellBlank(BlankedCell As Range) ' Ditto BlankedCell.Value = "" End Sub сама формула, то:
=IF(AND(COUNTBLANK($B2:$J2)lt;9,ISBLANK($A2)),(StaticDate($A2) CopyFormulaDown($XFD2)),IF(COUNTBLANK($B2:$J2)=9,(BlankOtherCell($A2) BlankOtherCell($XFD3)),"Date Previously Applied")) I’m learning as I go so I’m no expert or anything, but I’m having a hard time finding a solution to this one. That wasn’t the only iteration of the broken function I’ve tried, it’s just the latest (I was messing around in the macro recorder in desperation for this one, lol). I’d like to figure this out though since copy-pasting the formula every time manually is a pain and pasting it into the whole column makes excel run like me uphill (slowly and poorly). I’d appreciate any help anyone could give me here, and thanks for reading!