如何将一个或多个列对转换为Excel中的匹配记录？

问题描述：

Sheet 1 

Col1   Col2   Col3 
Miss Molly  Extra Data Extra Data 
Mister Rogers Extra Data Extra Data 
Roy Rogers  Extra Data Extra Data

和

Sheet 2 

Col1   Col2   Col3 
Miss Molly  Value Name 1 Value Data 1 
Miss Molly  Value Name 2 Value Data 2 
Mister Rogers Value Name 1 Value Data 1 
Roy Rogers  Value Name 1 Value Data 1 
Roy Rogers  Value Name 2 Value Data 2 
Roy Rogers  Value Name 3 Value Data 3

我如何结束了这样的换位输出？

Sheet X (you can make me a new sheet if you like, or add to Sheet 1) 

Col1   Col2   Col3  Col4   Col5   Col6   Col7   Col8   Col9 
Miss Molly  Extra Data Extra Data Value Name 1 Value Data 1 Value Name 2 Value Data 2 
Mister Rogers Extra Data Extra Data Value Name 1 Value Data 1 
Roy Rogers  Extra Data Extra Data Value Name 1 Value Data 1 Value Name 2 Value Data 2 Value Name 3 Value Data 3

答

试试这个

Sub MergeData() 
    Dim rSrc As Range 
    Dim rDst As Range 
    Dim rwSrc As Range 
    Dim rwDst As Range 
    Dim vSrc As Variant, vCopy As Variant 
    Dim cl As Range 
    Dim i As Long 

    Set rDst = ActiveWorkbook.Sheets("Sheet1").UsedRange 
    vSrc = ActiveWorkbook.Sheets("Sheet2").UsedRange 
    ReDim vCopy(1 To 1, 1 To 2) 
    Application.FindFormat.Clear 

    For i = 1 To UBound(vSrc, 1) 
     If vSrc(i, 1) <> "" Then 
      ' Find vSrc(i, 1) in rDst.Column(1) 
      Set cl = rDst.Columns(1).Find(_ 
       What:=vSrc(i, 1), _ 
       After:=rDst.Cells(1, 1), _ 
       LookIn:=xlFormulas, _ 
       LookAt:=xlWhole, _ 
       SearchOrder:=xlByColumns, _ 
       SearchDirection:=xlNext, _ 
       MatchCase:=False, _ 
       SearchFormat:=False) 

      ' Copy data to Dest sheet 
      If Not cl Is Nothing Then 
       Set cl = cl.End(xlToRight).Offset(0, 1) 
       vCopy(1, 1) = vSrc(i, 2) 
       vCopy(1, 2) = vSrc(i, 3) 
       cl.Resize(1, 2) = vCopy 
      Else 
       ' Name not found in Dest sheet 
      End If 
     End If 
    Next 
End Sub

如何将一个或多个列对转换为Excel中的匹配记录？

相关推荐