- 帖子
- 573
- 主題
- 72
- 精華
- 0
- 積分
- 670
- 點名
- 1
- 作業系統
- win7
- 軟體版本
- office 2010
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2012-10-30
- 最後登錄
- 2025-12-16
|
回復 198188
前輩沒先傳DATA OK版本給後學確認,那就再請前輩確認以下方案是否符合需求
Sub D ...
Andy2483 發表於 2025-11-3 10:33 
- 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 T Like "*[a-z]" Then Q = Left(T, Len(T) - 1) Else Q = "||"
- If Z(T) > 0 Or Z(Q) > 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 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
- 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
我的這個就沒問題，出現資料齊全。 |
|
發表於 2025-10-31 13:24
| 
