Создание повторяющихся строк на основе списка в другом столбце

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 

результирующей таблице после Macro/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 

Оставьте комментарий, как это работает.