Вставьте несколько строк на основе содержимого ячейки, а затем заполните их

Question

У меня следующая ситуация

1  Type 1         Data 1    Data 2   Data 3   Data 4
2  Type 1         Data 5    Data 6   Data 7   Data 8
3  Type 2         Data 9    Data 10  Data 11  Data 12
etc.

Где первый столбец является столбцом индекса, а 3-й столбец пуст.(Между столбцом 3 и столбцом, в котором начинаются данные, есть еще 5 пустых столбцов. Фактически данные начинаются с столбца 9, но для целей отображения я написал это так).

Я хочу сделать это на основе ячеекстолбца B, если это Тип 1, добавьте 5 пустых строк ниже, а если это Тип 2, добавьте 8 пустых строк ниже.Другими словами, строки типа 1 имеют 5 строк «сыновья», а строки типа 2 имеют 8 строк «сыновья»

Теперь мне нужно заполнить эти строки.У меня есть второй лист со списком из 5 элементов для типа 1 и 8 элементов для типа 2:

item 1.1         item 2.1
item 1.2         item 2.2
item 1.3         item 2.3
item 1.4         item 2.4
item 1.5         item 2.5
                 item 2.6
                 item 2.7
                 item 2.8

Мне нужно, чтобы это выглядело так (пустые строки в следующем только для целей отображения на этомстраницы, на фактическом листе не должно быть пустой строки):

1  Type 1            Data 1    Data 2    Data 3   Data 4
2  Item 1.1    1               Data 2             Data 4
3  Item 1.2    1               Data 2             Data 4 
4  Item 1.3    1               Data 2             Data 4
5  Item 1.4    1               Data 2             Data 4 
6  Item 1.5    1               Data 2             Data 4

7  Type 1            Data 5    Data 6    Data 7   Data 8
8  Item 1.1    7               Data 6             Data 8
10 Item 1.2    7               Data 6             Data 8
11 Item 1.3    7               Data 6             Data 8
12 Item 1.4    7               Data 6             Data 8
13 Item 1.5    7               Data 6             Data 8

14 Type 2            Data 9    Data 10   Data 11  Data 12
15 item 2.1    14              Data 10            Data 12
16 item 2.2    14              Data 10            Data 12
17 item 2.3    14              Data 10            Data 12
18 item 2.4    14              Data 10            Data 12
19 item 2.5    14              Data 10            Data 12
20 item 2.6    14              Data 10            Data 12
21 item 2.7    14              Data 10            Data 12
22 item 2.8    14              Data 10            Data 12
etc.

Обратите внимание, что произошла переиндексация, и 3-й столбец теперь заполнен индексом «родителя» (за исключениемродительские, которые останутся пустыми, как показано на рисунке).

Насчет распределения столбца B, обычно у меня есть весь тип 1, а затем тип 2. (Как показано в этом посте).

Я делал макросы в течение нескольких месяцев, но я не могу придумать макрос для этого, так как переиндексация и изменение размера действительно озадачивают меня.

Заранее спасибо.

Answer 1

Попробуйте:

    Sub test3()

    Dim i As Long, j As Long, LastRow1 As Long, No As Long, LastRow2 As Long, Times As Long
    Dim sType As String, Data As String, Data1 As String, Data2 As String, Data3 As String
    Dim ws1 As Worksheet, ws2 As Worksheet

    Set ws1 = ThisWorkbook.Worksheets("Sheet1")
    Set ws2 = ThisWorkbook.Worksheets("Sheet2")

        LastRow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row

        Number = 1

        For i = 2 To LastRow1

            No = ws1.Range("A" & i).Value
            sType = ws1.Range("B" & i).Value
            Data = ws1.Range("C" & i).Value
            Data1 = ws1.Range("D" & i).Value
            Data2 = ws1.Range("E" & i).Value
            Data3 = ws1.Range("F" & i).Value

            If i = 2 Then
                LastRow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row
            Else
                LastRow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row + 1
            End If

            ws2.Range("A" & LastRow2 + 1).Value = Number
            ws2.Range("B" & LastRow2 + 1).Value = sType
            ws2.Range("D" & LastRow2 + 1).Value = Data
            ws2.Range("E" & LastRow2 + 1).Value = Data1
            ws2.Range("F" & LastRow2 + 1).Value = Data2
            ws2.Range("G" & LastRow2 + 1).Value = Data3

            If Right(sType, 1) = 1 Then
                Times = 5
            ElseIf Right(sType, 1) = 2 Then
                Times = 8
            End If

            For j = 1 To Times

                LastRow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row

                ws2.Range("A" & LastRow2 + 1).Value = Number + j
                ws2.Range("B" & LastRow2 + 1).Value = "Item " & Right(sType, 1) & "." & j
                ws2.Range("C" & LastRow2 + 1).Value = Number
                ws2.Range("E" & LastRow2 + 1).Value = Data1
                ws2.Range("G" & LastRow2 + 1).Value = Data3

            Next j

            Number = Number + 6

        Next i

End Sub

Answer 2

Допустим следующие листы:

Рабочий лист "DataTable"

Рабочий лист "Элементы"
Обратите внимание, что заголовок в строке 1 здесь должен соответствовать данным столбца DataTable B!

С этим кодом…

Option Explicit

Public Sub FillInItems()
    Dim wsData As Worksheet 'define data sheet
    Set wsData = ThisWorkbook.Worksheets("DataTable")

    Dim wsItems As Worksheet 'define items sheet
    Set wsItems = ThisWorkbook.Worksheets("Items")

    Dim LastRow As Long 'find last used row in data
    LastRow = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row

    Dim iRow As Long
    iRow = 1 'data starts in row 1 (no headers)

    Dim idx As Long 'index counter in column A
    idx = wsData.Cells(1, "A").Value 'get index counter

    Do While iRow <= LastRow 'loop through all data rows
        Dim itmCol As Variant
        itmCol = Application.Match(wsData.Cells(iRow, "B").Value, wsItems.Rows(1), 0) 'find type
        If Not IsError(itmCol) Then
            Dim itmCount As Long
            itmCount = wsItems.Cells(wsItems.Rows.Count, itmCol).End(xlUp).Row - 1

            With wsData
                'insert rows
                .Rows(iRow + 1).Resize(RowSize:=itmCount).Insert xlShiftDown

                'write index
                .Cells(iRow, "A").Value = idx
                .Cells(iRow, "A").AutoFill Destination:=.Cells(iRow, "A").Resize(RowSize:=itmCount + 1), Type:=xlFillSeries
                .Cells(iRow + 1, "C").Resize(RowSize:=itmCount).Value = idx
                idx = idx + itmCount + 1

                'write items
                .Cells(iRow + 1, "B").Resize(RowSize:=itmCount).Value = wsItems.Cells(2, itmCol).Resize(RowSize:=itmCount).Value

                'copy 2 data rows down
                .Cells(iRow, "J").AutoFill Destination:=.Cells(iRow, "J").Resize(RowSize:=itmCount + 1), Type:=xlFillCopy
                .Cells(iRow, "L").AutoFill Destination:=.Cells(iRow, "L").Resize(RowSize:=itmCount + 1), Type:=xlFillCopy
            End With

            'adjust counters (because we added rows)
            iRow = iRow + itmCount
            LastRow = LastRow + itmCount
        End If
        iRow = iRow + 1
    Loop
End Sub

… результат будет