2011-03-23 71 views
1

我有两个Excel工作表:Sheet1和Sheet2。 Sheet2是主列表,而Sheet1是从系统接收的更新工作表。我需要的是将Sheet1的A栏的每个值与Sheet2进行比较。如果匹配,则我想从Sheet1复制整个匹配行,并将该行中的值粘贴到Sheet2的相应ColA值(Item#)行。如下例:如何将复制的行从一张纸粘贴到另一张

Sheet1工作表的

ColA          ColB 

Item#          Updated Cost 

1234          $30 

Sheet2工作表中

ColA          ColB 

Item#          Current Cost 

1234          $45 

有我的文件比这里显示的列多,所以它需要把整个一排与复制Sheet2中的相应行。我开始所需的Excel VBA代码,但是我被卡在零件上以在Sheet2中粘贴相应的值。我的代码是非常基本的,它还没有工作,所以任何与编码有关的帮助表示赞赏。

Sub Macro1() 
' 
' Macro1 Macro 
' 
' Copies corresponding item# rows from sheet1 worksheet 
' to sheet2 worksheet by comparing item# column 

Dim ws1 As Worksheet 
Dim ws2 As Worksheet 
Dim ColA As String 
Dim rng1 As Range 
Dim rng2 As Range 
Dim RowCounter1 As Integer 
Dim RowCounter2 As Integer 

ColA = "A" 

RowCounter1 = 2 
RowCounter2 = 2 

Set ws1 = Worksheets("Sheet1") 
Set ws2 = Worksheets("Sheet2") 

Do While Not IsEmpty(ws1.Range(ColA & RowCounter1).Value) 

    Set rng1 = ws1.Range(ColA & RowCounter1) 

    RowCounter2 = 1 
    Do While Not IsEmpty(ws2.Range(ColA & RowCounter2).Value) 

     Set rng2 = ws2.Range(ColA & RowCounter2) 
     If rng1.Value = rng2.Value Then 
      Rows(RowCounter1).EntireRow.Copy     
      RowCounter2 = RowCounter2 - 1 
     End If 
     RowCounter2 = RowCounter2 + 1 

    Loop 
    RowCounter1 = RowCounter1 + 1 
Loop 

End Sub 

回答

1

下面是关于如何使用PasteSpecial方法和一些代码的简化方式:

Sub Macro1() 

' 
' Macro1 Macro 
' 
' Copies corresponding item# rows from sheet1 worksheet 
' to sheet2 worksheet by comparing item# column 

Dim rng1 As Range, rng2 As Range 

For Each rng1 In Worksheets("Sheet1").Range("A2").Resize(Worksheets("Sheet1").Range("A2").CurrentRegion.Rows.Count - 1).Rows 
    For Each rng2 In Worksheets("Sheet2").Range("A2").Resize(Worksheets("Sheet2").Range("A2").CurrentRegion.Rows.Count - 1).Rows 
    If rng2(1).Value = rng1(1).Value Then 
     rng1.EntireRow.Copy 
     rng2.EntireRow.PasteSpecial (xlPasteValues) 
    End If 
    Next rng2 
Next rng1 

End Sub 
+0

此代码完美工作,再次感谢Lance – Thomas 2011-03-23 20:13:33

+0

如何更改它以剪切和粘贴整行而不是复制和粘贴?这里是我试过的代码,但没有工作:如果RNG2(1).value的= RNG1(1).value的那么 rng1.EntireRow.Cut rng2.EntireRow.Paste 结束如果 接下来RNG2 下一步RNG1 – Thomas 2011-03-24 13:07:49

+0

@Thomas,我总是使用PasteSpecial作为Range。 – 2011-03-24 14:53:29

0

这个片段可以帮助你(警告:不写任何测试)

Dim RowCollection As New Collection 

Dim rgRow1 As Range 
For Each rgRow1 In RangeFromSheet1 
    ' saves each sheet1 row indexed by the (string) value of the 1st cell 
    Call RowCollection.Add(rgRow, CStr(rgRow1.Cells(1, 1).Value)) 
Next rgRow1 

Dim rgRow2 As Range 
For Each rgRow2 In RangeFromSheet2 
    ' try to find matching row 
    On Error Resume Next 
    Set rgRow1 = Nothing 
    Set rgRow1 = RowCollection(CStr(rgRow2.Cells(1, 1).Value)) ' lookup using sheet2 val 
    On Error GoTo 0 
    If Not rgRow1 Is Nothing Then 
     rgRow2.Value = rgRow1.Value ' found a match, so copy values 
    End If 
Next rgRow2 

注:RowCollection.Add将失败的重复键值 - 所以,如果这是一个可能性,你需要添加一些额外的检查

+0

感谢您的代码tpascale。我使用了Lance提供的其他代码,但我很好奇,并且会尝试测试您的代码。再次感谢。 – Thomas 2011-03-23 20:43:35

+0

总是有很多方法来做事情。使用任何适合你的作品。但是,这里有一个提示:如果你深入到VBA中,熟悉集合是值得的,因为(i)VBA集合实现得很好并且非常高效,以及(ii)你以后可能会移植到的其他任何语言都会使用更多对容器类进行迭代的现代概念。 – tpascale 2011-03-28 11:15:46

0

使用此:

Sheet2.Select (Sheet1.Rows(index).Copy)  // Index is copy row index in sheet1 

Sheet2.Paste (Rows(index))  // Index is Paste row index in sheet2 
相关问题