如果列A中的单元格等于其他工作簿上的列A中的单元格复制该行

时间:2015-06-25 10:40:45

标签: excel vba excel-vba

我已经被困在这里多年了,我脑子里似乎相对简单但是我无法让它工作..所以我需要说的是,如果我在workbook1中有一个单元格等于Bob,如果那个单元格在另一个工作簿的同一列中,复制该行..

所以示例..如果在A列中找到Bob A workbook1,则在workbook2中将bob行中的b,c,d,e列中的任何内容复制到workbook2中。

我可以很容易地让它适用于单数,但它可以用于500多个条目。

我在这里尝试使用数组是我到目前为止所得到的(代码当前位于工作簿1上的按钮)

 Dim owb As Workbook
  Dim test1(500) As String, test2(500) As String, test3(500) As String, test4(500) As String 


With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
    .EnableEvents = False
End With

 fpath = "\Work\new location\test subject.xlsx" 'file location
   Set owb = Application.Workbooks.Open(fpath) 'open file
For i = 1 To 500 'for each I 


test1(i) = ThisWorkbook.Worksheets("Allsites").Cells(i, 1).Value
test2(i) = ThisWorkbook.Worksheets("Allsites").Cells(i, 8).Value
test3(i) = owb.Worksheets("Sheet2").Cells(i, 1).Value
test4(i) = owb.Worksheets("Sheet2").Cells(i, 2).Value 'declare locations

If test3(i) = test1(i) Then
test2(i) = test4(i)
End If
Next

1 个答案:

答案 0 :(得分:0)

在上面的示例中,您要检查确切单元格中的匹配项(例如A5中的值与A5中的值相同),因此我在下面的代码中假设相同。     Dim sourceSheet As Worksheet     Dim destinationSheet As Worksheet     Dim columnNumber As Integer

Set sourceSheet = Worksheets("Sheet3")
Set destinationSheet = Worksheets("Sheet2")

Dim sourceArr() As Variant
Dim destArr() As Variant
sourceArr = sourceSheet.Range("A1:E500")
destArr = destinationSheet.Range("A1:E500")

For i = 1 To 500 'for each I
    If destArr(i, 1) = sourceArr(i, 1) Then
        For columnNumber = 2 To 5
            destArr(i, columnNumber) = sourceArr(i, columnNumber)
        Next
    End If

Next
destinationSheet.Range("A1:A500").Value = destArr

有一篇关于在http://www.cpearson.com/excel/ArraysAndRanges.aspx的数组和工作表范围之间传输数据的文章。使用数组并一次写入整个数组将比单独写入每个单元格的值更快。

更新: 如果数据可以位于源电子表格的任何行中,则可以使用“查找”来搜索它。这可能会慢得多:

For i = 1 To 500 'for each I
    Dim found As Range

    Set found = searchRange.Find(destArr(i, 1), LookIn:=xlValues, lookat:=xlWhole)
    If Not found Is Nothing Then
        For columnNumber = 2 To 5
            destArr(i, columnNumber) = found.Offset(0, columnNumber - 1)
        Next
    End If
Next

您可能需要考虑在工作表中使用VLookup功能而不是使用VBA。