根据单行的单元格引用从另一个工作表复制公式

Question

这与我之前的帖子非常相似，但不是将公式复制到所有行，我只需要将公式复制到单行。基于单元格引用从另一个工作表复制公式

背景:我有一个工作表"指南输出"与列a:AE。每个列都有自己的公式，但是，并不是列中的每个单元格都有公式(有时我需要用纯文本覆盖它)。

问题:我有一个按钮，插入一个新行以上的选定行，然后从工作表"数据"粘贴到新行公式。问题是插入新行会破坏下一行公式的单元格引用。

所以我需要更新公式，但不能对整个行进行简单的剪切和粘贴，因为我不想覆盖公式已被纯文本替换的任何单元格。

我需要什么:宏，根据工作表"Guide Outputs"上单元格的列引用从工作表"Data"复制更新后的公式:

1. 当我点击"添加行"按钮时，
2. 在工作表'Guide Outputs'上插入新行，并从工作表'Data'中复制公式(这部分工作正常)，
3. 在工作表"引导输出"中，在插入行下面的行中，找到所有带有公式的单元格，
4. 查找工作表'Data'上的列，
5. 从工作表'Data'单元格复制公式(col=reference,row=3)，
6. 粘贴到工作表"指南输出"行中包含公式的单元格中(每列有不同的公式)，
7. 对每个单元重复。
8. 最终结果应该是所有带有公式的单元格都被更新为正确的公式，而带有纯文本的单元格被忽略。

这应该只更新插入行下面的单行，以便'修复'损坏的公式。

'Data'工作表中的公式位于单元格B3:AE3中。

例子:

工作表'Guide Outputs' H11, L11, M11, R11有公式，所以从工作表'Data' H3, L3, M3, R3复制/粘贴公式。

工作表"指导输出"B20, C20, L20, M20有公式，所以从工作表"数据"B3, C3, L3, M3复制/粘贴更新后的公式。

我是相当先进的公式，但在VBA新手。我可以记录宏和捣碎的东西在一起，我在网上找到，但这是关于它!

这与我之前的帖子非常相似，但不是将公式复制到所有行，我只需要将公式复制到单行。基于单元格引用从另一个工作表复制公式

下面是工作的部分，即插入新行，复制公式并将文本设置为蓝色。

我需要一些东西，现在修复损坏的公式在下一行。

Sub AddRow_Click()
'
' AddRow Macro
'
Selection.EntireRow.Insert
Sheets("Data").Range("B3:AE3").Copy
Sheets("Guide Outputs").Select

With ActiveCell
Range("B" & .Row & ":AE" & .Row).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With

Application.CutCopyMode = False

With Selection.Font
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0
End With
End Sub

Answer 1

Sub test()
Dim rg As Range, cell As Range
Selection.EntireRow.Insert
On Error Resume Next
Set rg = ActiveCell.Offset(1, 0).EntireRow.SpecialCells(xlCellTypeFormulas)
If Err.Number <> 0 Then ActiveCell.EntireRow.Delete: Exit Sub
For Each cell In rg
Sheets("DATA").Range(Replace(cell.Address, "$" & rg.Row, "$" & 3)).Copy Destination:=cell
Next
End Sub

将rg设置为插入行下的行中具有公式的所有单元格的范围。如果它不能创建rg，使用错误陷阱，删除插入的行，然后退出子。

然后循环到rg中的每个单元格(其中有公式)，然后通过将循环的单元格地址行号替换为3来获取表DATA中的公式，将公式复制到循环的单元格中。

如果我没理解错的话。

Answer 2

使用前一个答案中的代码，我稍微修改了一下。我想它现在可以和你的数据集一起工作了。

Sub UdateFormulas()
Const SRC_SHEET As String = "Data"
Const SRC_FIRST_CELL As String = "A3"
Const DST_SHEET As String = "Guide Outputs"
Const DST_FIRST_CELL As String = "A3"
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim dws As Worksheet: Set dws = wb.Sheets(DST_SHEET)
Dim drg As Range
Set drg = Range("B" & ActiveCell.Row & ":AE" & ActiveCell.Row)

Dim sws As Worksheet: Set sws = wb.Sheets(SRC_SHEET)
Dim srg As Range:
Set srg = sws.Range(SRC_FIRST_CELL).Resize(1, drg.Columns.Count)

'Application.ScreenUpdating = False
Dim dvrg As Object, dcrg As Object, c As Long
For Each dcrg In drg
dcrg.Activate
c = c + 1
On Error Resume Next
Set dvrg = dcrg.SpecialCells(xlCellTypeFormulas).Cells(1, 1)

On Error GoTo 0
If Not dvrg Is Nothing Then

dcrg = srg.Cells(1, c + 1).FormulaR1C1

Set dvrg = Nothing
'Else ' no formula in column; do nothing
End If
Next dcrg
Application.ScreenUpdating = False
MsgBox "Formulas updated.", vbInformation

结束子

添加原始帖子的链接，这样它就不会被认为是抄袭的:基于单元格引用从另一个工作表复制公式