How to transpose one or more column pairs to the matching record in Excel?

问题

Given data sets like this:

Sheet 1

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

and

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

How can I end up with a transposed output like this?

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

回答1:

Try this

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

来源：https://stackoverflow.com/questions/11919597/how-to-transpose-one-or-more-column-pairs-to-the-matching-record-in-excel