VBA复制粘贴

Question

因此，我有一个VBA，它应该复制"data"表上的内容，并通过搜索"Internal Use"中的单元格将其粘贴到"Internal Use"上--我没有收到错误，只是没有这样做，在运行宏之后，它只停留在“数据”表上。

我遗漏了什么？

Sub CommandButton2_Click()
Worksheets("Internal Use").Activate
project = Range("C4")
Worksheets("data").Activate
nr = Range("A" & Rows.Count).End(xlUp).Row
For Row = 2 To nr
If Range("F" & Row) = Worksheets("Internal Use").Range("C4") Then
Range("Q" & Row) = Worksheets("Internal Use").Range("C7")
End If

Next Row

End Sub

Answer 1

很难说出你想做什么。如果这是你想要的，请告诉我。

Sub CommandButton2_Click()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim nr As Long
Dim project As Variant

Set ws1 = ThisWorkbook.WorkSheets("Internal Use")
Set ws2 = ThisWorkbook.WorkSheets("data")
project = ws1.Range("C4").Value2

With ws1
    nr = .Range("A" & .Rows.Count).End(xlUp).Row

    For r = 2 To nr
        If .Range("F" & r) = project Then
            ws2.Range("Q" & r) = .Range("C7")
        End If
    Next
End With

End Sub

Answer 2

里卡多

你的代码运行良好。问题是你想要完成什么？如果你试图粘贴‘内部使用’工作表，你需要激活它。我增加了一条线来激活它。请更具体地说明你想要完成的事情。

Sub CommandButton2_Click()
Worksheets("Internal Use").Activate
project = Range("C4")
Worksheets("data").Activate
nr = Range("A" & Rows.Count).End(xlUp).Row
Worksheets("Internal Use").Activate
For Row = 2 To nr
If Range("F" & Row) = Worksheets("Internal Use").Range("C4") Then
Range("Q" & Row) = Worksheets("Internal Use").Range("C7")
End If

Next Row

End Sub

Answer 3

您希望在同一行的F列等于单元格C7时，使用工作表内部单元格C4的值填充数据表上的Q列。我不得不说，使用索引匹配的公式或像=If(F2='Internal Use'!$C$4,'Internal Use'!$C$7,"")这样的条件公式很容易解决这个问题(只需粘贴在F列中)。至少，这是您的代码目前或多或少要实现的目标。

这就是说，让我们看看您的代码:首先，避免.Activate，这是不必要的开销。这将激活工作表。(顺便说一句，您使用的最后一个.activate是在数据工作表上，因此它停留在那里)接下来，您将C4存储在一个称为项目的未声明变量中，而您从未使用过这个变量。接下来，您再次引用循环中各处的单元格。这意味着访问和读取这些单元的开销很大。最后，您可以在一个循环中这样做；我假设这样做是为了避免填充任何其他行。

要使代码正常工作，可以使用：

Sub CommandButton2_Click()
Dim project as string
Dim writeValue as string
Dim lr as long
Dim wr as long

project = Worksheets("Internal Use").Range("C4").value
writeValue = Worksheets("data").Range("C7").value

lr = Range("A" & Rows.Count).End(xlUp).Row

With Worksheets("data")
    For wr = 2 To lr
        If .Range("F" & wr).value = project Then
            .Range("Q" & rw).value = writeValue
        End If
    Next wr
End With
End Sub

这就行了。

Neater将避免for循环并测试所有单元格。两个选项是将整个f列和q列放入数组中，并同时遍历这些列，同时在将值转储回工作表之前更改q数组，或者使用查找算法(如Chip Pearons FindAll：http://www.cpearson.com/excel/findall.aspx )。