- 帖子
- 1446
- 主題
- 40
- 精華
- 0
- 積分
- 1470
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-10-21
|
6#
發表於 2024-3-7 09:59
| 只看該作者
回復 5# aassddff736
鋼板編號有重複,需手動排除重複後才顯示彙整資料:
Option Explicit
Sub 資料彙整入主頁篩選區()
Dim Brr, Crr, Z, Q, i&, j%, R&, N&, S, T$, E&, TT$
Set Z = CreateObject("Scripting.Dictionary")
With Sheets("主頁")
.Activate
If .AutoFilter Is Nothing Then [B17:P17].AutoFilter Else If .FilterMode = True Then .ShowAllData
With ActiveWindow
.FreezePanes = False
.ScrollRow = 13
.SplitRow = 5
.FreezePanes = True
End With
.UsedRange.Offset(17).EntireRow.Delete
.[B:D].NumberFormat = "@"
.[B:D].Font.Bold = True
End With
ReDim Crr(1 To 10000, 1 To 15)
Q = Array(Range([儲位!B3], [儲位!A65536].End(xlUp)), Range([儲位!E3], [儲位!D65536].End(xlUp)))
For Each Brr In Q
Brr = Brr
For i = 1 To UBound(Brr)
N = N + 1: T = Brr(i, 2): Crr(N, 1) = Brr(i, 1): Crr(N, 2) = T: Z(T) = N
Next
Next
E = N: Q = Array("1至588", "SUPER", "POWER", "POWER試產", "TEST", "待報廢", "報廢")
For Each S In Q
Brr = Sheets(S).[A1].CurrentRegion
For i = 3 To UBound(Brr)
R = Z(Brr(i, 1))
If Z.Exists(Brr(i, 2) & "|") Then TT = TT & " / " & S & "表_" & Brr(i, 2) Else Z(Brr(i, 2) & "|") = "A"
If R = 0 Then N = N + 1: R = N
For j = 1 To 14: Crr(R, j + 1) = Brr(i, j): Next
If R > E Then Crr(R, 1) = S
Next
Next
If N = 0 Then Exit Sub
If TT <> "" Then MsgBox "鋼板編號 " & Mid(TT, 4) & " 重複": Exit Sub
With [B18].Resize(N, 15): .Value = Crr: .Borders.LineStyle = 1: End With
End Sub
Sub 清除主頁篩選區資料()
With Sheets("主頁")
.Activate
If .AutoFilter Is Nothing Then [B17:P17].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 |
|
