从 sheet1 到 sheet2 的 VBA-Excel 匹配行问题

Question

以下代码比较 sheet2 的第 2 列，如果在 sheet1 的第 2 列上找到它，它将把整行复制到工作表 2 上。每一行都复制到找到的行下。我的问题是如何仅从找到的行中复制我想要的列并将其放在我想要的匹配行中的列中？

Before I run the code

Sheet1:
Col1   Col2   Col3    Col4    Col5    Col6    Col7    Col8
55555   123     a       6       r       7       h       f
55555   124     b       7       e       0       o       s
55555   333     c       8       f       3       l       j
55555   656     d       9       k       1       e       l
55555   219     e       10      i       m       l       p

Sheet2:
Col1    Col2   Col3    Col4    Col5    Col6    Col7    Col8
55555   123                     
55555   124                     
55555   333                     
55555   656                     
55555   219                     

Results After I run the code 

Sheet2:
Col1   Col2   Col3   Col4   Col5   Col6   Col7   Col8
Col1   Col2   Col3   Col4   Col5   Col6   Col7   Col8

55555   123                     
55555   123     a       6    r      7      h      f

55555   124                     
55555   124     b       7     e     0      o      s

55555   333                     
55555   333     c       8     f     3      l      j

55555   656                     
55555   656     d       9     k      1     e      l

55555   219                     
55555   219     e       10    i      3     l      p

Desired results Sheet2: Not the whole row is copied from Sheet1 just the desired columns are copied to the desired columns. Starting on row 2, so the headers on Sheet 2 are not effected.

Sheet2:
Col1   Col2   Col3   Col4   Col5   Col6   Col7   Col8
55555   123                          r      
55555   124                          e          
55555   333                          f      
55555   656                          k      
55555   219                          i      

下面是代码块。

Function Twins(RowIndex As Integer) As Boolean
    Dim Key
    Dim Target
    Dim Success
    Success = False
    If Not IsEmpty(Cells(RowIndex, 1).Value) Then
        Key = Cells(RowIndex, 2).Value

     Sheets("Sheet1").Select

        Set Target = Columns(2).Find(Key, LookIn:=xlValues)

        If Not Target Is Nothing Then
            Rows(Target.Row).Select
            Selection.Copy
            Sheets("Sheet2").Select
            Rows(RowIndex + 1).Select
            Selection.Insert Shift:=xlRight
            Rows(RowIndex + 2).Select
            Application.CutCopyMode = False
            Selection.Insert Shift:=xlRight, CopyOrigin:=xlFormatFromLeftOrAbove
            Cells(RowIndex + 3, 1).Select
            Success = True
        End If

    End If
    Twins = Success
End Function

Sub Match()
    Dim RowIndex As Integer
    Sheets("Sheet2").Select
    RowIndex = Cells.Row
    While Twins(RowIndex)
        RowIndex = RowIndex + 3
    Wend
End Sub

Answer 1

这可以使用一个简单的公式来完成，您可以在此处看到：

Sheet1 如下所示：

Col1.1   Col1.2
     a     1000
     b     2000
     c     3000

Sheet2 如下所示：

Col2.1   Col2.2
   aaa
     b
   ccc

在 Col2.2 中，我输入了以下公式（从单元格 B2 开始）：

=If(A2=Sheet1!A2;Sheet1!B2;"")

然后我把它拖到其他行，我得到了以下结果：

Col2.1    Col2.2
   aaa   <BLANK>
     b      2000
   ccc   <BLANK>

如果值不简单匹配（Sheet2!A1 可以在 Sheet1!A:A 中的任何位置），那么一个简单的 Vlookup() 公式可能就可以解决问题。