В Excel VBA создайте новые строки на основе данных столбца

Question

Для записи я являюсь нетренированным, записанным пользователем только для макросов VBA. Я пытаюсь забрать кусочки здесь и там, но я все еще полный ноб. Пожалуйста, указывайте мне в правильном направлении!

В каждой строке номер детали (столбец E) должен быть связан с источником и адресом (столбец G и H) и описанием (столбец I). Я говорю «должно быть», но на самом деле, а не на одном компиляторе источника/адреса для каждого номера детали, во многих файлах на некоторых строках имеется до пятнадцати различных комбинаций источников/адресов, а комманды source/address перечислены в смежных столбцы J/K, L/M, N/O и т. д., которые сдвигают столбец описания вправо.

Мне нужно найти метод VB для дублирования строк столько раз, сколько есть исходных/адресных комбо, и вырезать все, кроме одного комбо в строке. Вот пример:

A B C D Part# F Source1 Address1 Source2 Address2 Description 
1 x x x x Part1 x (S1)  (A1)       Nut 
2 x x x x Part2 x (S1)  (A1)  (S2)  (A2)  Bolt 

Row 2 имеет два источника/адреса комбо и должен быть повторен только один комбо на каждой строке, например:

A B C D Part# F Source Address Description 
1 x x x x Part1 x (S1)  (A1)  Nut 
2 x x x x Part2 x (S1)  (A1)  Bolt 
3 x x x x Part2 x (S2)  (A2)  Bolt 

В другом файле я мог бы иметь до пятнадцать различных комбинаций источников/адресов в любой заданной строке, которые затем должны дублироваться пятнадцать раз.

Это смысл? В моей голове я слышу функции VBA, которые я никогда не использовал, как цикл, do-while, do-until и т. Д., Но я не знаю достаточного синтаксиса для начала реализации чего-либо. Совет?

Answer 1

Sub Test() 

Dim rw As Range, rwDest As Range, cellSrc As Range 
Dim colDesc As Long, f As Range 

    colDesc = 0 
    'see if we can find the "description" column header 
    Set f = Sheet1.Rows(1).Find(what:="Description", LookIn:=xlValues, lookat:=xlWhole) 
    If Not f Is Nothing Then colDesc = f.Column 

    Set rw = Sheet1.Rows(2) 
    Do While Len(rw.Cells(, "E").Value) > 0 
     Set cellSrc = rw.Cells(, "G") 
     Do While Len(cellSrc.Value) > 0 And _ 
       UCase(Sheet1.Rows(1).Cells(cellSrc.Column).Value) Like "*SOURCE*" 
      Set rwDest = Sheet2.Cells(Rows.Count, "E").End(xlUp). _ 
         Offset(1, 0).EntireRow 
      rw.Cells(1).Resize(1, 6).Copy rwDest.Cells(1) 
      cellSrc.Resize(1, 2).Copy rwDest.Cells(7) 
      If colDesc > 0 Then rw.Cells(colDesc).Copy rwDest.Cells(9) 

      Set cellSrc = cellSrc.Offset(0, 2) 
     Loop 
     Set rw = rw.Offset(1, 0) 
    Loop 

End Sub