Andy2483

¦^´_ 2# 198188


    ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð«e½ú°Ñ¦Ò

Option Explicit
Sub TEST()
Dim Brr, Z, Q, i&, j%, N&, T$, T1$, MyPath$, xFile$, xBook As Workbook, MyBook As Workbook, Re
Set Z = CreateObject("Scripting.Dictionary")
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
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)
         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
      Z(Brr(i, 1)) = Z(Brr(i, 1)) + Val(Brr(i, 3))
      N = N + 1
      For j = 1 To 3: Brr(N, j) = Brr(i, j): Next
   End If
Next
If N > 0 Then Sheets("Layout Dwg").[K2].Resize(N, 3) = Brr: N = 0 Else MsgBox "Nothing2": 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))
   End If
Next
If N > 0 Then Sheets("Frame per Dwg").[N2].Resize(N, 6) = Brr: N = 0
Brr = xBook.Sheets("Part List").[A1].CurrentRegion
For i = 2 To UBound(Brr)
   If Z(Brr(i, 7)) > 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))
   End If
Next
If N > 0 Then Sheets("Part List").[U2].Resize(N, 13) = Brr
12: If Re = True Then xBook.Close 0
End Sub