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

Andy2483

¦^´_ 8# 198188


¥H¤U¤è®×½Ð¸Õ¸Õ¬Ý

Option Explicit
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(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 Z.Exists("|" & Left(Brr(i, 7), 2)) And 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").[A2].Resize(N, 13) = Brr Else MsgBox "Part List_Nothing"
12: If Re = True Then xBook.Close 0
End Sub

Andy2483

¦^´_ 13# 198188


¥H¤U¤è®×½Ð¸Õ¸Õ¬Ý

Option Explicit
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 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").[A2].Resize(N, 13) = Brr Else MsgBox "Part List_Nothing"
12: If Re = True Then xBook.Close 0
End Sub

Andy2483

·PÁ«e½ú«üÂI¡C
³o­Ó¤è®×¨ú®ø¤F¤@­Ó¤§«eªº³W«h¡A Layout Dwg ùØ­±ªº¤À§G¹Ï¦b Frame Per Dwg §ä¤£¨ìªº¡A ...
198188 µoªí©ó 2025-10-13 11:19

14#¤è®×¬O¨âªí³£·|§ä,©Ò¥H (FDªí ¤À§G¹Ï¸¹)  ©M (PLªí ¹ïÀ³²Õ¸Ë¸¹/¥[¤u¥ó¸¹) ¦pªG¸ê®Æ²Å¦XÅÞ¿è´N·|­«½Æ¥X²{
µø»Ý¨D¦A½Õ¾ã

Andy2483

¦^´_ 16# 198188


    ½d¨Ò ¥Í²£³æ³æ¸¹ ¸Ì¨S¦³ WO-J057-021

Andy2483

¦^´_ 8# 198188


    ¥H¤U¤è®×¬O½m²ß¥H  Data Base.xlsx §Q¥Î»²§UÄ檽±µ¿z¿ïªº¤è®×,½Ð«e½ú°Ñ¦Ò

1.¿ï¨ú­n¿z¿ïªº¶µ¥Ø
2.³]«ö¶s,«ö¶s°õ¦æ

¤U¸ü (152.88 KB)

3 ¤Ñ«e 13:52

Option Explicit
Sub TEST_2()
Dim Brr, Z, S, Q, i&, j%, C, R&, N&, T$, T1$
Application.ScreenUpdating = False
Set Z = CreateObject("Scripting.Dictionary")
Q = Split("Layout Dwg/Frame per Dwg/Part List/WO No", "/")
For Each S In Q
   With Sheets(S)
      C = Application.Match("»²§UÄæ", .[1:1], 0)
      If IsError(C) Then
         C = Range(.[A1], .UsedRange).Columns.Count
         C = C + 1
         .Cells(1, C) = "»²§UÄæ"
      End If
      Z(S & "//") = C
      .Activate
      If .AutoFilter Is Nothing Then
         .[A1].Resize(, C).AutoFilter
         With ActiveWindow
            .FreezePanes = False
            .ScrollRow = 1: .ScrollColumn = 1: .SplitRow = 1
            .FreezePanes = True
         End With
         Else
         If .FilterMode = True Then .ShowAllData
         ActiveWindow.ScrollRow = 1: ActiveWindow.ScrollColumn = 1
      End If
   End With
Next
R = Selection.Row
T = Cells(R, "B")
T1 = Cells(R, "C")
If T1 = "" Or T = "" Then Exit Sub Else Cells(R, "A").Resize(, 11).Select
For j = 6 To 11
   Z("|" & Cells(R, j)) = ""
Next
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 = Sheets("Layout Dwg").[A1].CurrentRegion
For i = 2 To UBound(Brr)
   Brr(i - 1, 1) = ""
   If Z.Exists(Brr(i, 2)) And Brr(i, 4) = T Then
      Z(Brr(i, 1)) = Z(Brr(i, 1)) + Val(Brr(i, 3))
      Brr(i - 1, 1) = T & "_" & T1
   End If
Next
C = Z("Layout Dwg//")
With Sheets("Layout Dwg")
   .Cells(2, C).Resize(UBound(Brr) - 1) = Brr
   .Cells.AutoFilter Field:=C, Criteria1:="<>"
End With
Brr = Sheets("Frame per Dwg").[A1].CurrentRegion
For i = 2 To UBound(Brr)
   Brr(i - 1, 1) = ""
   If Z.Exists("|" & Left(Brr(i, 2), 2)) Or Z(Brr(i, 1)) > 0 Then
      S = Brr(i, 5) * Z(Brr(i, 1))
      If S > 0 Then Brr(i - 1, 1) = S
   End If
Next
C = Z("Frame per Dwg//")
With Sheets("Frame per Dwg")
   .Cells(2, C).Resize(UBound(Brr) - 1) = Brr
   .Cells.AutoFilter Field:=C, Criteria1:="<>"
End With
Brr = Sheets("Part List").[A1].CurrentRegion
For i = 2 To UBound(Brr)
   Brr(i - 1, 1) = ""
   If Z(Brr(i, 7)) > 0 Then
      S = Brr(i, 3) * Z(Brr(i, 7))
      If S > 0 Then Brr(i - 1, 1) = S
   End If
Next
C = Z("Part List//")
With Sheets("Part List")
   .Cells(2, C).Resize(UBound(Brr) - 1) = Brr
   .Cells.AutoFilter Field:=C, Criteria1:="<>"
End With
End Sub

Andy2483

¦^´_ 21# 198188


WO Noªí¿ï¨ú 02F-04F«á,«ö¶s°õ¦æ:

¤U¸ü (152.88 KB)

«e¤Ñ 14:23

Layout Dwgªí·|±o¨ì²Å¦X¼Ó¼h¥B²Å¦X§å¦¸ªº¿z¿ï:

¤U¸ü (97.4 KB)

«e¤Ñ 14:25

Frame per Dwgªí·|±o¨ì²Å¦X±ø¥ó¥B¼Æ¶q>0ªº¿z¿ï:

¤U¸ü (137.9 KB)

«e¤Ñ 14:28

Part Listªí·|±o¨ì²Å¦X±ø¥ó¥B¼Æ¶q>0ªº¿z¿ï:

¤U¸ü (233.96 KB)

«e¤Ñ 14:29

Andy2483

¦^´_ 23# 198188


    ½Ð¥[¤J¥H¤U¬õ¦r¦æ¥N½X

If .AutoFilter Is Nothing Then
         .[A1].Resize(, C).AutoFilter
         With ActiveWindow
            .FreezePanes = False
            .ScrollRow = 1: .ScrollColumn = 1: .SplitRow = 1
            .FreezePanes = True
         End With
         Else
         .[A1].AutoFilter: .[A1].Resize(, C).AutoFilter
         If .FilterMode = True Then .ShowAllData
         ActiveWindow.ScrollRow = 1: ActiveWindow.ScrollColumn = 1
      End If