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