vba 仅复制列和粘贴公式 - 而不是值
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/33568248/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Copy column and paste formulas only - not values
提问by Nuno Nogueira
I'm trying to copy a column to the right of table and paste the formulas only (not values).
我正在尝试将一列复制到表格右侧并仅粘贴公式（而不是值）。
Sub acrescentaCols()
Dim oSheet As Worksheet
Set oSheet = Sheets("Sheet1")
oSheet.Columns("D:D").Select
Selection.Copy
Range(Selection, Selection.End(xlToRight)).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End Sub
But this is copying also the values (because Excel considers values to be a formula too).
但这也是复制值（因为 Excel 也将值视为公式）。
How do I fix this?
我该如何解决？
采纳答案by Scott Craner
As per my comments earlier:
根据我之前的评论：
Sub acrescentaCols()
Dim oSheet As Worksheet
Dim rng As Range
Dim cel As Range
Set oSheet = Sheets("Sheet1")
With oSheet
Set rng = .Range(.Range("D1"), .Range("D" & .Rows.Count).End(xlUp))
For Each cel In rng
If Left(cel.Formula, 1) = "=" Then
Range(cel.Offset(, 1), cel.Offset(, 1).End(xlToRight)).Formular1c1 = cel.Formular1c1
End If
Next cel
End With
End Sub
回答by Harley B
The below should fix your immediate problem of only copying the formulas across and not the values, but I'm not sure exactly what you're trying to do. If you can give more information I'm sure I can help you acheive what you're trying to get to.
下面应该解决您只复制公式而不是值的直接问题，但我不确定您到底要做什么。如果你能提供更多信息，我相信我可以帮助你实现你想要达到的目标。
It seems as if you want to copy the formulae to every row to the right of column D to the very right edge of the worksheet?
似乎您想将公式复制到 D 列右侧的每一行到工作表的最右侧边缘？
It also seems like you want to copy the formulae only so they re-evaluate in their new location - or do you want to past values only so that they hold the same values that they evaluated to in column D?
似乎您只想复制公式，以便它们在新位置重新计算 - 或者您是否只想过去的值，以便它们保持与 D 列中评估的值相同的值？
Anyway, give this a whirl.
无论如何，试一试。
Sub acrescentaCols()
Dim oSheet As Worksheet
Set oSheet = Sheets("Sheet1")
For Each cell In oSheet.Range("D1", Range("D1").End(xlDown))
If cell.HasFormula = True Then
cell.Copy
Range(cell.Address, Range(cell.Address).End(xlToRight)).PasteSpecial Paste:=xlPasteFormulas
End If
Next cell
End Sub
回答by Darren Bartrup-Cook
When you say paste the formula only - your method will paste the formula and then recalculate and your formula will show the result. I think a better way to write that would be:
当您说仅粘贴公式时 - 您的方法将粘贴公式，然后重新计算，您的公式将显示结果。我认为更好的写法是：
Sub acrescentaCols()
Dim oSheet As Worksheet
Dim rCopied As Range
Set oSheet = Sheets("Sheet1")
With oSheet
.Columns("D:D").Copy
Set rCopied = .Cells(1, 4).End(xlToRight).Offset(, 1).EntireColumn
rCopied.PasteSpecial Paste:=xlPasteFormulas
End With
End Sub
If you want to show the actual formula you could use a UDF something like:
如果你想显示实际的公式，你可以使用像这样的 UDF：
Function GetFormula(Target As Range) As String
If Target.HasFormula Then
GetFormula = Target.Formula
End If
End Function
If you want to apply this to a whole column you could use:
如果要将其应用于整个列，可以使用：
Sub acrescentaCols1()
Dim oSheet As Worksheet
Dim rCopied As Range
Set oSheet = Sheets("Sheet1")
With oSheet
Set rCopied = .Cells(1, 4).End(xlToRight).Offset(, 1).EntireColumn
rCopied.FormulaR1C1 = "=GETFORMULA(RC4)"
End With
End Sub
This will probably kill your spreadsheet though - it will execute the UDF on all rows.
这可能会杀死您的电子表格 - 它会在所有行上执行 UDF。
回答by user3819867
Sub acrescentaCols()
Dim oSheet As Worksheet, rng1 As Range, rng2 As Range, rng As Range
Set oSheet = Sheets("Sheet1")
Set rng1 = oSheet.Columns("D:D")
Set rng1 = Intersect(rng1, rng1.Worksheet.UsedRange) 'for the used range only
Set rng2 = Range(rng1, rng1.End(xlToRight))
For i = 1 To rng1.Cells.Count 'for each row
If Left(rng1(i, 1).Formula, 1) = "=" Then 'if it starts with an equal sign
For j = 1 To rng2.Columns.Count 'then for each column in the copy
rng2(i, j).FormulaR1C1 = rng1(i, 1).FormulaR1C1
Next j
End If
Next i
End Sub
