0

我在 2 个 Excel 工作表中有信息，我想将它们合并到另一个工作表中，以便为第一个工作表中的每个数据项添加第二个工作表中所有数据行的副本。例如：

第一张  
     一个  
部门 1  
部门 2  
部门 3  

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

表 2  
    生长激素  
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 回答