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列和数据开始的列之间还有5个空列。数据实际上从第9列开始，但是出于显示目的，我这样写了它。）

我要基于列B的单元格执行操作，如果是类型1，则在下面添加5空行，如果是类型2，则在下面添加8空行。换句话说，类型1的行有5个“儿子”行，类型2的行有8个“儿子”行

现在我需要填写这些行。我有第二张工作表，其中列出了类型1的5个项目和类型2的8个项目：

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.

请注意，已经进行了重新索引编制，并且第三列现在已填充“父级”索引（父级索引除外，它将保留为空，如图所示）。

关于B列的分布，通常我一共有类型1，然后是类型2。（作为本文的设置）。

我已经做了几个月的宏了，但是我无法为此提供一个宏，因为重新索引和调整大小确实让我感到困惑。

先谢谢了。

Answer 1

假设以下工作表：

工作表“数据表”

工作表“项目”
请注意，此处第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

…结果将是

Answer 2

尝试：

    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

根据单元格包含的内容插入多行，然后填充它们

2 个答案: