0

2 つの Excel ワークシートに情報があり、それらを別のワークシートに結合して、最初のワークシートのすべてのデータ項目に対して、2 番目のワークシートのすべてのデータ行のコピーが追加されるようにします。例えば：

シート 1  
     あ  
部門1  
部門2  
部門3  

----------------------------------------------

シート 2  
    FGH  
ItemCode1、ItemDesc1、ItemCost1  
ItemCode2、ItemDesc2、ItemCost2  
ItemCode3、ItemDesc3、ItemCost3  
ItemCode4、ItemDesc4、ItemCost4  
ItemCode5、ItemDesc5、ItemCost5  

----------------------------------------------

結果シート 3  
      AFGH  
部門 1、ItemCode1、ItemDesc1、ItemCost1  
部門 1、ItemCode2、ItemDesc2、ItemCost2  
部門 1、ItemCode3、ItemDesc3、ItemCost3  
部門 1、ItemCode4、ItemDesc4、ItemCost4  
部門 1、ItemCode5、ItemDesc5、ItemCost5  
部門 2、ItemCode1、ItemDesc1、ItemCost1  
部門 2、ItemCode2、ItemDesc2、ItemCost2  
部門 2、ItemCode3、ItemDesc3、ItemCost3  
部門 2、ItemCode4、ItemDesc4、ItemCost4  
部門 2、ItemCode5、ItemDesc5、ItemCost5  
部門 3、ItemCode1、ItemDesc1、ItemCost1  
部門 3、ItemCode2、ItemDesc2、ItemCost2  
部門 3、ItemCode3、ItemDesc3、ItemCost3  
部門 3、ItemCode4、ItemDesc4、ItemCost4  
部門 3、ItemCode5、ItemDesc5、ItemCost5

誰でもこれで私を助けることができますか? これまでのところ、新しいシートを構築するデータを繰り返し処理しようとしていますが、もっと簡単な方法があるのではないかと考えています。

4

1 に答える 1

0

以下は、上記の VBA コードです。理解を深めるために、コードを分析してトレースします。
機械的な方法で行われます (コピーして貼り付けるだけです)。
これはもっとうまくできたかもしれませんが、私のものはかなり大きなコードだと思います。 

Sub Macro1()

Dim wkbk As Workbook
Dim i As Integer

Dim lastrow As Long
Dim lastrow3 As Long
Dim lastrowref As Long

i = 1

Set wkbk = ActiveWorkbook

    Do
        ' to find the range(used to paste values in sheet 3(Column A-Department1
        'and cloumn B( for Values in sheet2)
        lastrowref = lastrow3 + 1

        With wkbk.Sheets(2).Select
        Range("f1:H1").Select
        Range(Selection, Selection.End(xlDown)).Select

        Selection.Copy
        End With

        With wkbk.Sheets(3).Select
        Cells(lastrowref, 6).Select
        ActiveSheet.Paste
        End With

                    With ActiveWorkbook.Sheets(3)
' to find the cells where data needs to be pasted
                    lastrow3 = .Range("f1").End(xlDown).Row
                    End With


                    Sheets("Sheet1").Select
                    With ActiveWorkbook.Sheets(1)
'to find the number of records in sheet1
                    lastrow = .Range("a1").End(xlDown).Row
                    End With

                    With ActiveWorkbook.Sheets(1)
                    .Cells(i, 1).Select
                    Selection.Copy
                    End With

        With wkbk.Sheets(3).Select
        Range(Cells(lastrow3, 1), Cells(lastrowref, 1)).Select
        ActiveSheet.Paste
        End With
' loops till the Number of departments in sheet1
               i = i + 1
    Loop While i <= lastrow


End Sub
于 2013-10-31T10:54:42.657 に答える