VBA复制和粘贴

时间:2016-02-01 22:45:40

标签: excel-vba vba excel

所以我有一个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

3 个答案:

答案 0 :(得分:0)

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

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

答案 1 :(得分:0)

里卡多,

您的代码运行正常。问题是你想要完成什么?如果您尝试粘贴“内部使用”表,则需要激活它。我添加了一行来激活它。请详细说明您想要完成的任务。

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

答案 2 :(得分:0)

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

那说让我们来看看你的代码: 首先避免.Activate,这是不必要的开销。这将激活工作表。 (顺便说一下,你使用的最后一个.activate是在数据工作表上,因此它保留在那里)接下来,你将C4存储在一个你从不使用的名为project的未声明变量中。 接下来,再次引用循环中的所有单元格。这意味着访问和读取这些单元格会产生巨大的开销。最后你在循环中这样做;我认为这是为了避免填满任何其他行。

要使代码正常工作,您可以使用:

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 < / p>