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

Question

下面的代码比较sheet2的第2列，如果在sheet1的第2列中找到了，就会把整行复制到sheet2上。每一行都会复制到找到的行下面。我的问题是，如何从找到的那行中只复制我想要的列，并把它放在匹配行上我想要的列中？

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() 公式可能做的伎俩。