- 帖子
- 1567
- 主題
- 40
- 精華
- 0
- 積分
- 1591
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2026-2-2
|
86#
發表於 2025-10-29 14:52
| 只看該作者
回復 85# 198188
先測試 DATA:
Sub Data()
Dim Arr, Brr, Crr, Z, Q, S, i&, j%, N&, T$, T1$, MyPath$, xFile$, xBook As Workbook, Re, R&
Application.ScreenUpdating = False
For Each S In [{"Layout Dwg","Frame per Dwg","Part List"}]
Sheets(S).UsedRange.Rows.Offset(1).EntireRow.Delete
'↑刪除本檔舊資料
Next
MyPath = ThisWorkbook.Path & "\"
xFile = "Data Base1.xlsx"
On Error Resume Next
Set xBook = Workbooks(xFile)
If xBook Is Nothing Then
Set xBook = Workbooks.Open(MyPath & xFile, , True, , "")
Re = True: ThisWorkbook.Activate
End If
On Error GoTo 0
Set Z = CreateObject("Scripting.Dictionary")
T = Sheets("Read").[A2] & "|" & Sheets("Read").[C2]
T1 = Sheets("Read").[B2]
With xBook.Sheets("WO No")
For i = 2 To .[A65536].End(3).Row
If .Cells(i, "B") & "|" & .Cells(i, "D") = T Then
.Rows(i).Copy Sheets("WO No").Rows(2)
For j = 6 To 11
Z("|" & .Cells(i, j)) = ""
'↑令WO No表的 F-K 欄的 字母前方連接"|"字元當key,item是空字元納入Z字典
Next
Sheets("Read").[A2].Resize(, 3).Copy Sheets("WO No").[B2]
GoTo 11
End If
Next
MsgBox "Nothing": Exit Sub
End With
11
If T1 Like "##F-*##F" Then
For i = Val(T1) To Val(StrReverse(Mid(StrReverse(T1), 2, 2)))
Z(Format(i, "00F")) = ""
Next
Else
Q = Split(T1 & "&" & T1, "&")
For i = 0 To UBound(Q)
Z(Q(i)) = 0
Next
End If
Brr = xBook.Sheets("Layout Dwg").[A1].CurrentRegion
For i = 2 To UBound(Brr)
If Z.Exists(Brr(i, 2)) And Brr(i, 4) = Sheets("Read").[A2] Then
'↑如果B欄 樓層及 D欄 批次次序吻合
Z(Brr(i, 1)) = Z(Brr(i, 1)) + Val(Brr(i, 3))
'↑本檔的Layout Dwg表 的A欄 分佈圖號(其C欄數量要加總,以下稱:LD合計數量)
N = N + 1
For j = 1 To 4: Brr(N, j) = Brr(i, j): Next
End If
Next
If N > 0 Then Sheets("Layout Dwg").[A2].Resize(N, 4) = Brr: N = 0 Else MsgBox "Nothing under the floor": GoTo 12
Brr = xBook.Sheets("Frame per Dwg").[A1].CurrentRegion
For i = 2 To UBound(Brr)
If Z(Brr(i, 1)) > 0 Then
N = N + 1
For j = 1 To 6: Brr(N, j) = Brr(i, j): Next
Brr(N, 5) = Brr(N, 5) * Z(Brr(i, 1))
'↑本檔的Frame per Dwg,其中E欄的數量要*LD合計數量
If Z(Brr(i, 2)) > 0 Then
MsgBox "Layout Dwg表A欄(分佈圖號)與 Frame per Dwg表B欄(組裝圖號)重複" & vbLf & vbLf & Brr(i, 2)
Exit Sub
End If
Z(Brr(i, 2) & "/") = Z(Brr(i, 2) & "/") + Brr(N, 5)
'↑本檔的Frame per Dwg表 的B欄 組裝圖號 (其E欄數量要加總,以下稱:FD合計數量)
End If
Next
If N > 0 Then Sheets("Frame per Dwg").[A2].Resize(N, 6) = Brr: N = 0 Else MsgBox "Frame per Dwg_Nothing"
Brr = xBook.Sheets("Part List").[A1].CurrentRegion
ReDim Arr(1 To 100000, 1 To 13): Crr = Arr
For i = 2 To UBound(Brr)
T = Brr(i, 8)
If T Like "*[a-z]" Then Q = Left(T, Len(T) - 1) Else Q = "||"
If Z(T) > 0 Or Z(Q) > 0 Then
N = N + 1
For j = 1 To 13: Arr(N, j) = Brr(i, j): Next
Arr(N, 3) = Arr(N, 3) * (Z(T) + Z(Q))
End If
'↑1.本檔的Layout Dwg表 的A欄 分佈圖號 要比對 Data Base 裡Part List表的H欄 分佈圖編號
'1.1.若吻合時整列帶出來到本檔的Part List,其中C欄的數量要*LD合計數量
'1.1.若Data Base 裡Part List表H欄字串尾部多了個小寫英文字母去除後也吻合 本檔的Layout Dwg表 的A欄 分佈圖號 時,也整列帶出來到本檔的Part List,其中C欄的數量要*LD合計數量
If Z(T & "/") > 0 And Z.Exists("|" & Left(T, 2)) Then
R = R + 1
For j = 1 To 13: Crr(R, j) = Brr(i, j): Next
Crr(R, 3) = Crr(R, 3) * Z(T & "/")
'↑2.本檔的Frame per Dwg表 的B欄 組裝圖號(前2字元含有 WO No 表的 F - K 欄 的 字母) 要比對 Data Base 裡Part List表的H欄 分佈圖編號
'2.1.若吻合時整列帶出來到本檔的Part List,其中C欄的數量要*FD合計數量
End If
Next
If N > 0 Then
With Sheets("Part List").[A2].Resize(N, 13)
.Value = Arr
.Interior.ColorIndex = 35
'↑分佈圖號帶出來的儲存格底色是 綠色
End With
End If
If R > 0 Then
With Sheets("Part List").Cells(N + 2, 1).Resize(R, 13)
.Value = Crr
.Interior.ColorIndex = 36
'↑組裝圖號帶出來的儲存格底色是 黃色(組裝圖號帶出來的在後段)
End With
End If
If N + R = 0 Then MsgBox "Part List_Nothing"
12: If Re = True Then xBook.Close 0
End Sub |
|
