Option Explicit
Sub updateList()
Application.ScreenUpdating = False '取消屏幕闪烁
Dim i As Integer '循环index
Dim j As Integer '横向index
Dim k As Integer '输出index
k = 2 '设置辅助表行数初始值
For i = 1 To ThisWorkbook.Names.Count
ThisWorkbook.Names(1).Delete '循环删除名称管理器中内容
Next
With Sheet1
'第一部分
.Range("L:IV").ClearContents '删除L列到最后一列的内容
For i = 2 To .Range("I" & 2 ^ 16).End(xlUp).Row '从第2行开始直到【工序】列最后一位不为空的值所在行
If .Range("G" & i).Value <> "" Then '如果【名称】列当前值不为空
j = 13 '则使列初始值为13,也就是L列
.Range("L" & k).Value = .Range("G" & i).Value 'L列输入G列内容即——"名称"
If i > 2 Then '当获取行数大于2时,也就是从基础数据表第3行开始获取时
.Cells(k, j).Value = .Range("H" & i).Value '横向填充【图号】列内容。同时满足【名称】列当前行不为空的条件
.Cells(2, .Range("IV2").End(xlToLeft).Column + 1).Value = .Range("G" & i).Value '横向填充【名称】列内容
End If
k = k + 1 '执行完后,行数值+1
ElseIf .Range("H" & i).Value <> "" Then '否则如果【图号】列当前行不为空时,此时为避免该列中存在多个合并单元格的情况出现
j = j + 1 '列号+1,也就是往右平移一个位置
If i > 2 Then .Cells(k - 1, j).Value = .Range("H" & i).Value '横向填充【图号】列内容
End If
Next
'第二部分
For i = 3 To .Range("I" & 2 ^ 16).End(xlUp).Row '从第3行开始直到【工序】列最后一位不为空的值所在行
If .Range("H" & i).Value <> "" Then '如果【图号】列当前值不为空
j = 13 '则使列初始值为13,也就是L列
.Range("L" & k).Value = .Range("H" & i).Value '纵向填充【图号】列内容,初始行数值k由上述循环结果决定,接下来的k值由本次循环结果决定
.Cells(k, j).Value = .Range("I" & i).Value '横向填充【工序】列内容
k = k + 1
Else
j = j + 1 '否则,列号+1,也就是往右平移一个位置
.Cells(k - 1, j).Value = .Range("I" & i).Value '横向填充【工序】列内容
End If
Next
'定义名称
.Range("L:IV").SpecialCells(xlCellTypeConstants, 23).CreateNames False, True, False, False '创建名称
End With
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
updateList
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'更新列表
If Target.Column = 2 And Target.Row > 2 Then
ActiveCell.Offset(0, 1).Value = ""
ActiveCell.Offset(0, 2).Value = ""
ElseIf Target.Column = 3 And Target.Row > 2 Then
ActiveCell.Offset(0, 1).Value = ""
End If
'更新辅助表
If Target.Column > 6 And Target.Column < 11 And Target.Row > 1 Then
updateList
End If
End Sub