Question

我有一个包含35列公式的工作表，用于查找其他工作表中的数据。每次将数据输入查找工作表（＆＃34;数据＆＃34;）时，我想在行的底部添加另一组公式。我已设法获取代码，将这35列上的正确公式复制到底部的正确位置。但是当它们粘贴时，会复制公式的确切文本，而不是更改引用的单元格。

e.g。公式＆＃34; = OFFSET（数据！$ B $ 1，（A7736-1）* 34,0）＆＃34; 从第7736行复制到第8300行应该变为 = OFFSET（数据！$ B $ 1，（A8300-1）* 34,0）但保持为＆＃34; = OFFSET（数据！$ B $ 1，（A7736-1）* 34,0）＆＃34;

这是我的代码

Dim workbk As Workbook
Dim databk As Workbook
Dim MRD As Worksheet
Dim formularrange As Range 
Dim lasttrayname As String   
Dim datarow As Long
Dim nrow As Long
Dim loopcount As Long
Dim urow As Long

Set workbk = ActiveWorkbook

'set Macro recording information sheet
Set MRD = Worksheets("Macro RunDate")

'find last date updated
urow = Worksheets("Macro RunDate").Range("A" & Rows.Count).End(xlUp).Row

'find last tray used
lasttray = MRD.Range("B" & urow).Value

'find row to paste raw tray data
datarow = Worksheets("Data").Range("A" & Rows.Count).End(xlUp).Row

    Do while *condition*

    '...More code here....

    Loopcount = 0
    Loopcount = loopcount + 34
    Loop

Go to Tidy:

 Tidy:

 If loopcount > 0 Then

'convert to correct number of rows to copy
 loopcount = (loopcount)/34*8

        'copy formulas in Sheet2 for correct number of trays     
        'determine end row by finding "lasttray"
        nrow = Worksheets("Sheet2").Range("A:A").Find(What:=lasttray, _
        SearchOrder:=xlByRows, LookIn:=xlValues, SearchDirection:=xlNext).Row + 8


'repeat formulas
 Worksheets("Sheet2").Range(Cells(nrow + 1, "A"), Cells(nrow + loopcount + 1, _
 "S")).Formula = Worksheets("Sheet2").Range("A3975:s" & 3975 + loopcount).Formula

'calculate formula values
Worksheets("Sheet2").Range("A:E").Calculate

End If

所以我的问题是，如何复制这些公式并获取更改的参考？

提前致谢

Answer 1

您可以使用复制：

，而不是设置公式属性

Dim Source As Range
Dim Dest As Range

Set Source = Worksheets("Sheet2").Range("A3975:s" & 3975 + loopcount)
Set Dest = Worksheets("Sheet2").Range(Cells(nrow + 1, "A"), Cells(nrow + loopcount + 1, _
"S"))
Source.Copy Dest

然后，Excel将增加行号，就像手动复制时一样。

Answer 2

不使用cell1 = cell2，而是执行以下操作：

Range(cell1).Select
Application.CutCopyMode = False
Selection.Copy
Range(cell2).Select
ActiveSheet.Paste

那应该粘贴相对公式。

Answer 3

使用 .FormulaR1C1 而不是 .Formula。

– 来自 @Rory 2014 年 6 月 4 日 13:16 的评论

复制期间更改公式引用

3 个答案: