Question

我在工作表中有一个项目编号列表，在另一个工作表中有一个组织编号列表。我想复制每个组织编号的每个项目编号行。它看起来像这样：

启动项目表

PROJECT  EFF_DATE END_EFF_DATE DESCRIPTION
420000  1/11/2015   12/30/3000  Project 1  
420007  1/11/2015   12/30/3000  Project 2
420008  1/11/2015   12/30/3000  Project 3

启动订单号表

Order Number
3710
3700
3715

运行宏/ VBA后生成的表

PROJECT  EFF_DATE END_EFF_DATE DESCRIPTION  Order Number
420000  1/11/2015   12/30/3000  Project 1     3710
420007  1/11/2015   12/30/3000  Project 2     3710
420008  1/11/2015   12/30/3000  Project 3     3710
420000  1/11/2015   12/30/3000  Project 1     3700
420007  1/11/2015   12/30/3000  Project 2     3700
420008  1/11/2015   12/30/3000  Project 3     3700
420000  1/11/2015   12/30/3000  Project 1     3715
420007  1/11/2015   12/30/3000  Project 2     3715
420008  1/11/2015   12/30/3000  Project 3     3715

我尝试过使用宏和vba但没有取得多大成功。有什么建议/想法吗？如果可能的话，我希望它是自动化的，结果是一个包含已排序信息的新工作表。

由于

Answer 1

这是我到目前为止所得到的。如果你的两张纸被分类，这段代码将满足你的需求。

但是，在第三张表格中，您提供了一个标题行，就像您在结果示例中一样。

Sub sortProj()

    Dim i As Integer, j As Integer, z As Integer

    i = 2
    z = 2
    While ThisWorkbook.Sheets(2).Cells(i, 1) <> ""
        j = 2
        While ThisWorkbook.Sheets(1).Cells(j, 1) <> ""
            ThisWorkbook.Sheets(1).Cells(j, 1).EntireRow.Copy

            ThisWorkbook.Sheets(3).Cells(z, 1).Insert
            ThisWorkbook.Sheets(3).Cells(z, getEmptyCol) = ThisWorkbook.Sheets(2).Cells(i, 1)
            z = z + 1
            j = j + 1
        Wend
        i = i + 1
    Wend



End Sub

Function getEmptyCol() As Double

    Dim a As Integer
    a = 1
    While ThisWorkbook.Sheets(3).Cells(1, a) <> ""
        a = a + 1
    Wend

    getEmptyCol = a

End Function

请对其工作原理发表评论。

根据另一列中的列表创建重复行

1 个答案: