Question

我的数据为

Row1 2012 12 13 14 15 16

Row2 2013 10 20 30 40 50

Row3 2014 54 34 50 67 78

Row4 2015 67 82 33 44 66

我的column3，column4，column5，column6，column7中有公式我的最低价值可能是2012年或2013年或2014年。让我们说它是2013年。我想创建一个宏，当yr小于最小值时，将整个行粘贴为值。在这种情况下，我希望将行R1粘贴为值，因为我的min是2013，其余的仍然与公式相同。

我尝试了下面的宏，但卡在了专门的部分。请帮我调试或以更有效的方式编写它。

Sub pasteasvalues()
Application.ScreenUpdating= False

Dim rng as Range
Dim cell as Variant
   Sheets("working").Activate
   Set rng=Range("A1:A4")
   For each cell in rng
   If cell.value=2013 then
   cell.EntireRow.copy
   cell.EntireRow.PasteSpecial Paste:x1PasteValues
   End if
   Next

End Sub

我在粘贴：x1PasteValues部分中遇到错误。让我知道我哪里出错或如何更有效地写它

Answer 1

您可以通过制作range.value = range.value来移除公式，您不需要复制/粘贴特殊。

Sub pasteasvalues()
    Dim Sh As Worksheet
    Dim rng As Range
    Dim cell As Range
    Set Sh = Sheets("working")
    Set rng = Sh.Range("A1:A4")
    For Each cell In rng.Cells
        If cell.Value = 2013 Then cell.EntireRow.Value = cell.EntireRow.Value
    Next cell

End Sub

Answer 2

Sub pasteasvalues()
Application.ScreenUpdating = False

Dim rng As Range
Dim cell As Variant

Sheets("working").Activate
Set rng = Range("A1:A4")        

    For Each cell In rng
           If cell.Value = 2013 Then
               cell.EntireRow.Copy
               Range("a6").Select
               Selection.PasteSpecial Paste:=xlPasteValues,Operation:=xlNone, SkipBlanks :=False, Transpose:=False
            End If
     Next

End Sub

VBA宏：如何将范围的每个值检查到特定值，并使用VBA宏将特定行（范围）粘贴为pastespecial？

2 个答案: