Question

我有两个Excel工作表：Sheet1和Sheet2。 Sheet2是主列表，而Sheet1是我从系统收到的更新工作表。我需要的是比较Sheet1的Col 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

Answer 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

Answer 2

此代码段可能会对您有所帮助（警告：未经任何测试而写入）

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会在重复的键值上失败 - 所以如果有可能你需要添加一些额外的检查

Answer 3

使用此功能：

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

Sheet2.Paste (Rows(index))       // Index is Paste row index in sheet2

如何将复制行从一个工作表粘贴到另一个工作表

3 个答案: