- 帖子
- 582
- 主題
- 75
- 精華
- 0
- 積分
- 682
- 點名
- 0
- 作業系統
- win7
- 軟體版本
- office 2010
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2012-10-30
- 最後登錄
- 2026-4-13
|
- Sub Data()
- Dim Arr, Brr, Crr, Z, Q, S, i&, j%, N&, T$, T1$, MyPath$, xFile$, xBook As Workbook, Re, R&
- Dim rng, cell As Range
- Application.ScreenUpdating = False
- For Each S In [{"Layout Dwg","Frame per Dwg","Part List"}]
- Sheets(S).UsedRange.Rows.Offset(1).EntireRow.Delete
- 'Delete Old data of "Layout Dwg","Frame per Dwg","Part List" from this workbook
- Next
- MyPath = ThisWorkbook.Path & "\"
- xFile = "Data Base.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)) = ""
- 'Let Column F-K of WO No Sheet as KEY item and add "|" between each word then put into dictionary
- 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").UsedRange
- For i = 2 To UBound(Brr)
- If Z.Exists(Brr(i, 2)) And Brr(i, 4) = Sheets("Read").[A2] Then
- 'If match of column B floor and column D batch
- Z(Brr(i, 1)) = Z(Brr(i, 1)) + Val(Brr(i, 3))
- 'Sum of column C QTY of same of column A "Distribution Map No." of "Layout Dwg" (Name as:LDTotalQTY)
- 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").UsedRange
- 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))
- 'Let Column E QTY of "Frame per Dwg" * LDTotalQTY
- If Z(Brr(i, 2)) > 0 Then
- MsgBox "*Layout Dwg* A column and *Frame per Dwg* B column are duplicate" & vbLf & vbLf & Brr(i, 2)
- Exit Sub
- End If
- Z(Brr(i, 2) & "/") = Z(Brr(i, 2) & "/") + Brr(N, 5)
- 'Sum of Column E QTY of "Frame per Dwg" Column B "Assembly Drawing No." (Name as: FDTotalQTY)
- 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").UsedRange
- ReDim Arr(1 To 100000, 1 To 13): Crr = Arr
- For i = 2 To UBound(Brr)
- T = Brr(i, 8)
-
- If Z(T) > 0 Then
- Set rng = Sheets("Frame per Dwg").Columns("A:A")
- Set cell = rng.Find(What:=T, LookIn:=xlFormulas, _
- LookAt:=xlWhole, MatchCase:=False)
- If cell Is Nothing 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
- End If
- '1.Filter Layout Dwg column A "Distribution Map No." of this workbook which don't appear on the Frame per Dwg of this workbook
- '1.1 Match of Layout Dwg column A "Distribution Map No." of this workbook and Part List column H "Distribution Map No." of Data Base workbook
- '1.2 If (1.) Match, list out the row on Part List of this workbook and column C QTY * LDTotalQTY
- '1.3 If the last word column H is lowercase letter of "Part List" of Data Base workbook, then remove the lowercase letter and match column A of "Layout Dwg" of this workbook, then list out the row on Part List of this workbook and column C QTY * LDTotalQTY
- 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. Column B "Assembly Drawing No." of "Frame per Dwg" of this workbook including column F-K of WO No, then match column H "Distribution Map No." of "Part List" of Data Base workbook
- '2.1 If (2.1) match, list out the row on Part List of this workbook and column C QTY * FDTotalQTY
- End If
- Next
- If Sheets("WO No").[F2] = "BW" Or Sheets("WO No").[F2] = "TW" Then
- If N > 0 Then
- With Sheets("Part List").[A2].Resize(N, 13)
- .Value = Arr
- .Interior.ColorIndex = 35
- 'Let Green which item list out by "Distribution Map No."
- End With
- End If
- Else
- N = 0
- End If
- If R > 0 Then
- With Sheets("Part List").Cells(N + 2, 1).Resize(R, 13)
- .Value = Crr
- .Interior.ColorIndex = 36
- 'Let Yellow which item list out by "Assembly Drawing No."
- End With
- End If
- If N + R = 0 Then MsgBox "Part List_Nothing"
- 12: If Re = True Then xBook.Close 0
- End Sub
回復 198188
Data的修改方案也提供參考:
Sub Data()
Dim Arr, Brr, Crr, Z, Q, S, i&, j%, ...
Andy2483 發表於 2025-11-5 14:04 
Part List 數據規則有紅色部分修改： 附上修改程式碼
本檔 WO No 表資料顯示規則如下：
1.本檔的Read 表的 A 欄 批次次序，B 欄 樓層 ，C 欄 生產單號 比對Data Base 檔裏 WO No 表的 B 欄 批次次序, C 欄 樓層 及 D欄 生產單號
1.1 若吻合時整列帶出來到本檔的WO No
本檔 Layout Dwg表資料顯示規則如下：
1.本檔的 WO No 表的 C 欄 樓層 比對 Data Base 檔裏 Layout Dwg 表的 B 欄 樓層
1.1 若吻合時, 整列帶出來到本檔的WO No
本檔Frame per Dwg 表資料顯示規則如下：
1. 本檔的Layout Dwg表 的A欄 分佈圖號(其C欄數量 (相同分佈圖號) 要加總,以下稱:LD合計數量) 要比對 Data Base 檔裡Frame per Dwg 表的A欄 分佈圖號
1.1 若吻合時, 整列帶出來到本檔的Frame per Dwg,其中E欄的數量要*LD合計數量
本檔Part List 表資料顯示規則如下：
1. 本檔的 WO No 表的 “F2-K2”儲存格是 ”BW” or “TW”
1.1本檔的Layout Dwg表 的A欄 分佈圖號 要比對本檔的Frame per Dwg 表的A欄 分佈圖號，如果沒有在本檔的Frame per Dwg 表裏出現
1.2 若吻合時, 本檔的Layout Dwg表 的A欄 分佈圖號(其C欄數量(相同分佈圖號)要加總,以下稱:LD合計數量) 要比對 Data Base檔 裡Part List表的H欄 分佈圖編號
1.3若吻合時, 整列帶出來到本檔的Part List,其中C欄的數量要*LD合計數量
2.1 本檔的 WO No 表的 “F2-K2”儲存格不是 ”BW” or “TW”
2.本檔的Frame per Dwg表 的B欄 組裝圖號 (其E欄數量 (相同組裝圖號) 要加總,以下稱:FD合計數量) 也要比對 Data Base檔 裡Part List表的H欄 分佈圖編號
2.1 若吻合時, 本檔的Frame per Dwg表 的B欄 組裝圖號 需要含有 WO No 表的 F - K 欄 的 字母
2.2.若吻合時, 整列也帶出來到本檔的Part List,其中C欄的數量要*FD合計數量 |
|
發表於 2025-11-3 15:41
| 
