我有以下情况
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。(作为本文的设置)。
我已经做了几个月的宏了,但是我无法为此提供一个宏,因为重新索引和调整大小确实让我感到困惑。
先谢谢了。
答案 0 :(得分:0)
假设以下工作表:
工作表“项目”
请注意,此处第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
…结果将是
答案 1 :(得分:0)
尝试:
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