0

このようなデータセットが与えられた場合：

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
4

1 に答える 1

1

これを試して

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
于 2012-08-12T04:35:42.853 に答える