- 帖子
- 582
- 主題
- 75
- 精華
- 0
- 積分
- 682
- 點名
- 0
- 作業系統
- win7
- 軟體版本
- office 2010
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2012-10-30
- 最後登錄
- 2026-4-13
|
59#
發表於 2025-10-28 11:04
| 只看該作者
- Sub TEST_2()
- Dim Brr, Z, Q, i&, j%, N&, T$, T1$, MyPath$, xFile$, xBook As Workbook, MyBook As Workbook, Re
- Application.ScreenUpdating = False
- With Sheets("Layout Dwg")
- .[A2].Resize(.UsedRange.Rows.Count, 4).ClearContents
- End With
- With Sheets("Frame per Dwg")
- .[A2].Resize(.UsedRange.Rows.Count, 6).ClearContents
- End With
- With Sheets("Part List")
- .[A2].Resize(.UsedRange.Rows.Count, 13).ClearContents
- End With
- Set MyBook = ThisWorkbook
- MyPath = MyBook.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
- MyBook.Activate
- End If
- Set Z = CreateObject("Scripting.Dictionary")
- On Error GoTo 0
- 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)) = ""
- 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)) Then
- If Brr(i, 4) = Sheets("Read").[A2] Then
- Z(Brr(i, 1)) = Z(Brr(i, 1)) + Val(Brr(i, 3))
- N = N + 1
- For j = 1 To 4: Brr(N, j) = Brr(i, j): Next
- End If
- 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.Exists("|" & Left(Brr(i, 2), 2)) And 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))
- 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
- For i = 2 To UBound(Brr)
- If Brr(i, 7) Like "*[a-z]" Then Q = Left(Brr(i, 7), Len(Brr(i, 7)) - 1) Else Q = ""
- If Z(Brr(i, 7)) > 0 Or Z(Q) > 0 Then
- N = N + 1
- For j = 1 To 13: Brr(N, j) = Brr(i, j): Next
- Brr(N, 3) = Brr(N, 3) * (Z(Brr(i, 7)) + Z(Q))
- End If
- Next
- If N > 0 Then Sheets("Part List").[A2].Resize(N, 13) = Brr Else MsgBox "Part List_Nothing"
- 12: If Re = True Then xBook.Close 0
- End Sub
回復 198188
Brr(N, 3) = Brr(N, 3) * Z(Brr(i, 7))
這行也要改成以下,數量才會是0
Br ...
Andy2483 發表於 2025-10-28 10:48 
這個不對，改了這個 Frame per Dwg 變成了 只有 WS 的組裝圖號，其他的不出現。
我剛剛說的是針對 Part List 的内容， Frame per Dwg 之前的内容是正確的。
Frame per Dwg 内容規則：
在 Frame per Dwg 導出 與 Layout Dwg 相同的分佈圖號，Layout Dwg相同圖號數量相加 然後跟 Frame per Dwg 數量相乘
Part List 内容規則：
1） Layout Dwg 分佈圖號 在 Frame per Dwg 裏面沒有出現的，要在 Part List 出現，數量相乘
2）在上面規則下，附加多一個條件，如果 Part List 分佈圖號 最後一個字母是小寫英文字母，那麽 Part List 分佈圖號 包含 Layout Dwg 分佈圖號 的也顯示出來。
3）Frame per Dwg 的組裝圖 欄B 含有 WO No 的 欄 F - K 各樣數據字母，要在 Part List 出現 數量相乘 |
|
