- 帖子
- 1446
- 主題
- 40
- 精華
- 0
- 積分
- 1470
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-10-21
|
17#
發表於 2024-3-8 08:40
| 只看該作者
回復 11# aassddff736
謝謝論壇,謝謝各位前輩
Option Explicit
Sub 資料彙整入主頁篩選區()
Application.ScreenUpdating = False: Application.DisplayAlerts = False
Dim Arr, Brr, Crr(1 To 10000, 1 To 1), Z, Q, i&, j%, R&, N&, S, T$, E&, TT$, xR As Range
Set Z = CreateObject("Scripting.Dictionary")
With Sheets("主頁")
.Activate: If .AutoFilter Is Nothing Then [B17:Q17].AutoFilter Else If .FilterMode = True Then .ShowAllData
With ActiveWindow: .FreezePanes = False: .ScrollRow = 13: .SplitRow = 5: .FreezePanes = True: End With: .UsedRange.Offset(17).EntireRow.Delete
End With
Q = Array("1至588", "SUPER", "POWER", "POWER試產", "TEST", "待報廢", "報廢")
For Each S In Q
Set xR = [D65536].End(3)(2, 0): If Sheets(S).FilterMode = True Then Sheets(S).ShowAllData
R = Sheets(S).[B65536].End(3).Row - 2: Sheets(S).[A3].Resize(R, 14).Copy xR: If InStr("待報廢", S) Then xR.Resize(R, 1).Offset(, -1) = S
Next
Set Brr = Range([P18], [D65536].End(3)(1, -1)): Brr.Font.Size = 8: N = Brr.Rows.Count: Brr = Brr.Resize(10000).Resize(, 2)
For i = 1 To UBound(Brr): Z(Brr(i, 2)) = i: Next: Z.Remove ("")
Q = Array(Range([儲位!B3], [儲位!A65536].End(xlUp)), Range([儲位!E3], [儲位!D65536].End(xlUp)))
For Each Arr In Q
Arr = Arr
For i = 1 To UBound(Arr)
T = Arr(i, 2): If Z.Exists(T) Then Brr(Z(T), 1) = Arr(i, 1) Else N = N + 1: Brr(N, 1) = Arr(i, 1): Brr(N, 2) = Arr(i, 2)
Next
Next
With [B18].Resize(N, 2): .Value = Brr: .Resize(, 15).Borders.LineStyle = 1: .EntireRow.AutoFit: End With: Call 註解_調整至指定位置
End Sub
Sub 註解_調整至指定位置()
Dim CO As Comment, SL&, ST&
For Each CO In ActiveSheet.Comments
With CO
With Range(.Parent.Address): SL = .Left + .Width + 10: ST = .Top + 10: End With: With .Shape: .Left = SL: .Top = ST: End With
.Shape.TextFrame.Characters.Font.Size = 12: .Shape.DrawingObject.AutoSize = True
End With
Next
Application.DisplayCommentIndicator = -1
End Sub
Sub 清除主頁篩選區資料()
With Sheets("主頁")
.Activate: If .AutoFilter Is Nothing Then [B17:Q17].AutoFilter Else If .FilterMode = True Then .ShowAllData
With ActiveWindow: .FreezePanes = False: .ScrollRow = 1: .SplitRow = 17: .FreezePanes = True: End With: .UsedRange.Offset(17).EntireRow.Delete
End With
End Sub
Sub 主頁篩選區資料_全部顯示()
With Sheets("主頁")
.Activate: If .AutoFilter Is Nothing Then [B17:Q17].AutoFilter Else If .FilterMode = True Then .ShowAllData
With ActiveWindow: .FreezePanes = False: .ScrollRow = 13: .SplitRow = 5: .FreezePanes = True: .ScrollRow = 1: End With
If .[D65536].End(3).Row = 17 Then Call 資料彙整入主頁篩選區
End With
End Sub
Sub 空儲位()
Call 主頁篩選區資料_全部顯示: Selection.AutoFilter Field:=2, Criteria1:="<>": Selection.AutoFilter Field:=3, Criteria1:="="
End Sub
Sub 沒有儲位的鋼板()
Call 主頁篩選區資料_全部顯示: Selection.AutoFilter Field:=3, Criteria1:="<>": Selection.AutoFilter Field:=2, Criteria1:="="
End Sub |
|
