VBA多級聯動更新程式碼
阿新 • • 發佈:2019-02-19
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