Andy2483

¦^´_ 189# 198188


1.¦ó¿×:µµ¦â¦X¦}­«½Æªº½s½X?
2.Á`¼Æ¶q¬Û¥[©ú½T,Á`­«¶q»Ý­n¬Û¥[¶Ü? ¨ä¥LÄæ¦ì¬O§_¤]¦³²Ö¥[ªº¥²­n?
3.Fabrication Extrusionªí[A3:F3]­n¦X¨ÖÀx¦s®æ¶Ü?
4.BOM¦³ ­n¨D¥æ³f´Áªº¤TºØ§å¦¸,©Ò¤W¶Ç½d¨Òª½±µ¥[Á`¥¿½T¶Ü?
5.Finish¼ÒªO±a¤J³W«h¦p¦ó?
½Ð¤W¶Ç½d¨ÒÀÉ

½Ð°Ý¦b¦¹¤§«eªºµ²ªGÀÉ & PDFÀɬO«ç»ò°µ¥X¨Óªº,½Ð¤W¶Ç³o¨Çµ²ªGÀÉ©ÎPDFÀÉ(¥h°£­Ó¸ê/°Ó¸¹...µ¥°Ó¾÷¸ê°T)

198188

¦^´_  198188


1.¦ó¿×:µµ¦â¦X¦}­«½Æªº½s½X?
2.Á`¼Æ¶q¬Û¥[©ú½T,Á`­«¶q»Ý­n¬Û¥[¶Ü? ¨ä¥LÄæ¦ì¬O§_¤]¦³²Ö ...
Andy2483 µoªí©ó 2025-11-14 15:40

¤U¸ü (121.87 KB)

2025-11-14 16:12

1.¦ó¿×:µµ¦â¦X¦}­«½Æªº½s½X? ªþ¥óµµ¦âªº·N«ä¬O«ü¨º­Ó½s¸¹ªº¼Æ¶q¥[Á`¤F¡C¨S¦³顔¦âªº¡A«ü¤£»Ý­n¥[Á`¡A½Ð¬Ý¤W¹Ï

2.Á`¼Æ¶q¬Û¥[©ú½T,Á`­«¶q»Ý­n¬Û¥[¶Ü? ¨ä¥LÄæ¦ì¬O§_¤]¦³²Ö¥[ªº¥²­n? Á`­«¶q¬O Á`¼Æ¶q * Material ªí K Äæ ³æ­«¡A¦pªGMaterial ªí K Äæ ³æ­«¬OªÅ¥Õ¡A¨º麽Á`­«¶q´NªÅ¥Õ¡C
¦³Á`­«¶qªº¼ÒªO¡GGasket ªí J Äæ¡ADN Material ªí H Äæ¡AFinish ªíFÄæ

3.Fabrication Extrusionªí[A3:F3]­n¦X¨ÖÀx¦s®æ¶Ü? ¬O¦X¨ÖÀx¦s®æ, ¤§«e¼ÒªOº|¤F¦X¨Ö¡C[A3:F3] ¬O²{¥Ü­^¤å "Fabrication Order Sheet For Extrusion Parts"¡A[A4:F4]¬OÅã¥Ü¤¤¤å "¥[¤u²M³æ"

4.BOM¦³ ­n¨D¥æ³f´Áªº¤TºØ§å¦¸,©Ò¤W¶Ç½d¨Òª½±µ¥[Á`¥¿½T¶Ü? J Äæ Åã¥Ü¥[Á`ªº¼Æ¶q´N¥i¥H¡A«á­±[L : Q ]§å¦¸¬O¤H¤â¦Û§Ú½Õ¾ã¡C

5.Finish¼ÒªO±a¤J³W«h¦p¦ó? ³o­ÓÀ³¸Ó¤U©P¥i¥H½T»{¡C³W«h¥u¼vÅT B Äæ ³æ¤¸¥ó½s¸¹¡A EÄæ Á`¼Æ¶q©M GÄæ³Æª`¡A¨ä¥L C, DÄæ¤]¬OŪ¨ú Material ªíªº¹ïÀ³¸ê®Æ

Andy2483

¦^´_ 192# 198188


    ½Ð«e½ú¸Õ¸Õ¬Ý

Option Explicit
Public A, Z, R&, W, L, i&, Brr, Mrr, Q, Drr, j%, MyPath$
Sub Form()
Dim Arr, Crr(1 To 100000, 1 To 18), xW$, S, T$, T2$, Ts, xFile$, xBook As Workbook, Re
Ts = Timer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
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
Mrr = xBook.Sheets("Material").UsedRange
If Re = True Then xBook.Close 0
Call RuleRun

For i = 2 To UBound(Mrr): Z(Mrr(i, 3) & "/m") = i: Next
For i = Worksheets.Count To 1 Step -1
   If Z(Sheets(i).Name & "/s") <> "" Then Sheets(i).Delete
Next
If Sheets("Part List").FilterMode = True Then Sheets("Part List").ShowAllData
With Range(Sheets("Part List").[P1], Sheets("Part List").[A65536].End(3)(2))
   With .Columns(15): .Cells = "=ROW()": .Value = .Value: End With
   Brr = .Value
   ReDim Arr(1 To UBound(Brr) - 1, 1 To 1)
   For i = 2 To UBound(Brr)
      T = Left(Brr(i, 1), 2) & "-" & Brr(i, 7)
      If InStr("Y-O", Right(T, 1)) Then Arr(i - 1, 1) = Z(T)
   Next
   .Cells(2, 16).Resize(UBound(Brr) - 1, 1) = Arr
   .Sort KEY1:=.Item(16), Order1:=1, KEY2:=.Item(1), Order1:=1, Header:=1
   Brr = .Value
   .Sort KEY1:=.Item(15), Order1:=1, Header:=1
   .Cells(1, 15).Resize(, 2).EntireColumn.Delete
   A = Crr
   For i = 2 To UBound(Brr) - 1
      If Brr(i, 16) = "" Then Exit For Else T = Brr(i, 16)
      Run Replace(Z(T & "/s"), " ", "_")
      If T <> Brr(i + 1, 16) Then
         Sheets(Z(T & "/s")).Copy Before:=Sheets(1)
         ActiveSheet.Name = T
         With Cells(Z(Z(T & "/s") & "/UR"), 1).Resize(R, Z(Z(T & "/s") & "/UC"))
            .Value = A
            .Borders.LineStyle = xlContinuous
            ActiveSheet.PageSetup.PrintArea = Range([A1], .Cells).Address
         End With
         With Range(Z(Z(T & "/s") & "/V1")): .Value = Z(T & Switch(InStr("E0-Y E0--", T) Or InStr("WT", Right(T, 1)), "/RE", T = T, "/ER")): End With
         With Range(Z(Z(T & "/s") & "/V2")): .Value = Z(T & Switch(InStr("M4-- M4-Y IG--", T), "/EEC", InStr("E0-Y E0--", T) Or InStr("WT", Right(T, 1)), "/RC", T = T, "/EE")): End With
         With Range(Z(Z(T & "/s") & "/V3")): .Value = Z(T & "/EC"): .ShrinkToFit = True: End With
         A = Crr: R = 0
      End If
   Next
End With
ThisWorkbook.Activate
Set Z = Nothing
Erase Arr, Brr, Crr, A, Mrr
MsgBox Timer - Ts & " S"
End Sub

Sub RuleRun()
Dim T$, T2$, S$, i&, j%
Set Z = CreateObject("Scripting.Dictionary")
Brr = [Rule!A1].CurrentRegion
For i = 3 To UBound(Brr)
   For j = 2 To 8
      T = Brr(i, j)
      If T <> "" Then
         If Z(T & "|") = "" Or j = 5 Or j = 8 Then
            Z(T & "^") = Brr(2, j)
            Z(T & "|") = Trim(Mid(Brr(2, j), 1, Len(Brr(2, j)) * 2 - LenB(StrConv(Brr(2, j), vbFromUnicode)) - 2))
         End If
         Exit For
      End If
   Next
   For j = 11 To 28
      If Brr(i, j) = "" Then Exit For
      T2 = Brr(i, 11) & "-" & T
      Z(Brr(i, j) & "-" & T) = T2
      If Z(T2 & "/") = "" Then
         Z(T2 & "/") = Brr(i, 9) & "-" & Z(T & "|")
         Z(T2 & "/ER") = Z(T & "^")
         Z(T2 & "/EE") = Brr(i, 9)
         Z(T2 & "/EC") = Brr(i, 10)
         Z(T2 & "/EEC") = Brr(i, 9) & "/" & Brr(i, 10)
         Z(T2 & "/RC") = Trim(Replace(Replace(Z(T & "^"), Z(T & "|"), ""), "-", ""))
         Z(T2 & "/RE") = Z(T & "|")
      End If
      S = Brr(i, 1)
      Z(T2 & "/s") = S
      Z(S & "/UR") = Sheets(S).[A65536].End(3)(2).Row
      Z(S & "/UC") = Sheets(S).Cells(Z(S & "/UR") - 1, 256).End(xlToLeft).Column
      Z(S & "/V1") = Switch(S = "Bom", "L3", S = "Gasket", "D4", S = "Structural", "C4", S = "Fabrication Extrusion", "A3", S = "Finish", "A3", S = "DN Material", "A3")
      Z(S & "/V2") = Switch(S = "Bom", "A4", S = "Gasket", "D3", S = "Structural", "C3", S = "Fabrication Extrusion", "A4", S = "Finish", "A4", S = "DN Material", "A4")
      Z(S & "/V3") = Switch(S = "Bom", "A5", S = "Gasket", "E3", S = "Structural", "D3", S = "Fabrication Extrusion", "B3", S = "Finish", "B3", S = "DN Material", "B3")
   Next
Next
End Sub

Sub Bom()
If Brr(i, 1) = Brr(i - 1, 1) Then A(R, 10) = A(R, 10) + Brr(i, 3): Exit Sub
R = R + 1: A(R, 1) = R: A(R, 2) = Brr(i, 1): A(R, 3) = Brr(i, 12)
If A(R, 3) <> "" And Z.Exists(A(R, 3) & "/m") Then
   For j = 0 To 5: A(R, Array(4, 5, 6, 8, 9, 13)(j)) = Mrr(Z(A(R, 3) & "/m"), Array(5, 6, 7, 11, 10, 8)(j)): Next
End If
A(R, 7) = Brr(i, 4) & " x " & Brr(i, 5)
A(R, 10) = Brr(i, 3)
A(R, 18) = Brr(i, 7)
End Sub

Sub Gasket()
If Brr(i, 1) = Brr(i - 1, 1) Then A(R, 9) = A(R, 9) + Brr(i, 3):   Exit Sub
R = R + 1: A(R, 1) = R
For j = 0 To 5: A(R, Array(2, 9, 6, 7, 11, 3)(j)) = Brr(i, Array(1, 3, 5, 6, 7, 12)(j)): Next
If A(R, 3) <> "" And Z.Exists(A(R, 3) & "/m") Then
   For j = 0 To 2: A(R, Array(4, 5, 8)(j)) = Mrr(Z(A(R, 3) & "/m"), Array(5, 6, 8)(j)): Next
End If
End Sub

Sub Structural()
If Brr(i, 1) = Brr(i - 1, 1) Then A(R, 5) = A(R, 5) + Brr(i, 3): Exit Sub
R = R + 1: A(R, 1) = R
For j = 0 To 2: A(R, Array(2, 3, 5)(j)) = Brr(i, Array(1, 2, 3)(j)): Next
L = Split(Brr(i, 2) & "mm", "mm")(0)
W = Split(Brr(i, 2) & "mm", "mm")(1)
L = Val(StrReverse(Mid(Val(StrReverse(L & 1)), 2)))
W = Val(StrReverse(Mid(Val(StrReverse(W & 1)), 2)))
A(R, 6) = L * W
A(R, 8) = A(R, 5) * A(R, 6) / 1000
A(R, 7) = Application.RoundUp(A(R, 5) * A(R, 6) / 1000, 0)
End Sub

Sub DN_Material()
If Brr(i, 1) = Brr(i - 1, 1) Then A(R, 7) = A(R, 7) + Brr(i, 3):   Exit Sub
R = R + 1: A(R, 1) = R
For j = 0 To 3: A(R, Array(2, 3, 4, 7)(j)) = Brr(i, Array(1, 12, 5, 3)(j)): Next
If A(R, 3) <> "" And Z.Exists(A(R, 3) & "/m") Then
   A(R, 5) = Mrr(Z(A(R, 3) & "/m"), 11)
   A(R, 6) = Mrr(Z(A(R, 3) & "/m"), 8)
   A(R, 8) = A(R, 5) * A(R, 7)
End If
A(R, 9) = Brr(i, 7)
End Sub

Sub Fabrication_Extrusion()
If Brr(i, 1) = Brr(i - 1, 1) Then
   A(R, 6) = A(R, 6) + Brr(i, 3)
   Exit Sub
End If
R = R + 1: A(R, 1) = R
For j = 0 To 5: A(R, Array(2, 3, 4, 5, 6, 7)(j)) = Brr(i, Array(1, 11, 10, 4, 3, 1)(j)): Next
If A(R, 7) Like "*-*-*" Then
   Q = Split(A(R, 7), "-")
   A(R, 7) = Q(0) & "-" & Q(1)
End If
A(R, 8) = Brr(i, 7)
End Sub

Sub Finish()
If Brr(i, 1) = Brr(i - 1, 1) Then A(R, 5) = A(R, 5) + Brr(i, 5): Exit Sub
R = R + 1: A(R, 1) = R
For j = 0 To 4: A(R, Array(2, 3, 4, 5, 7)(j)) = Brr(i, Array(2, 3, 4, 5, 6)(j)): Next
End Sub

198188

¦^´_  198188


    ½Ð«e½ú¸Õ¸Õ¬Ý

Option Explicit
Public A, Z, R&, W, L, i&, Brr, Mrr, Q, Drr, ...
Andy2483 µoªí©ó 2025-11-17 10:52

   «e½ú¡Aªì¨B¸Õ¤F¡A§Ú§â°ÝÃD¼g¦bªþ¥ó ¡§¦³°ÝÃDªº¦a¤è¡¨
¼Æ¶q¥[Á`©M¦X¦}¼È®É¥¼µo²{°ÝÃD¡A§Ú·|¦AÄ~Äò´ú¸Õ¡A¦p¦³°ÝÃD¦A´£¥X¡C

198188

1. Sub Bom()
   
2. If Brr(i, 1) = Brr(i - 1, 1) Then A(R, 10) = A(R, 10) + Brr(i, 3): A(R, 14) = A(R, 10): Exit Sub
   
3. R = R + 1: A(R, 1) = R: A(R, 2) = Brr(i, 1): A(R, 3) = Brr(i, 12)
   
4. If A(R, 3) <> "" And Z.Exists(A(R, 3) & "/m") Then
   
5.    For j = 0 To 5: A(R, Array(4, 5, 6, 8, 9, 13)(j)) = Mrr(Z(A(R, 3) & "/m"), Array(5, 6, 7, 11, 10, 8)(j)): Next
   
6. End If
   
7. A(R, 7) = Brr(i, 4) & " x " & Brr(i, 5)
   
8. A(R, 10) = Brr(i, 3)
   
9. A(R, 14) = Brr(i, 3)
   
10. A(R, 18) = Brr(i, 7)
    
11. End Sub

½Æ»s¥N½X

«e½ú¡Aªì¨B¸Õ¤F¡A§Ú§â°ÝÃD¼g¦bªþ¥ó ¡§¦³°ÝÃDªº¦a¤è¡¨
¼Æ¶q¥[Á`©M¦X¦}¼È®É¥¼µo²{°ÝÃD¡A§Ú·|¦AÄ~Äò ...
198188 µoªí©ó 2025-11-17 16:13

Bom ¼ÒªO        ¤U­±¥¼¾É¥X¸ê®Æ
¥»ÀÉ Bom ªí D Äæ ­^¤å´y­z        Data Base ÀÉ Material ªíÄæ E ­^¤å´y­z(¹ï«È¤á)  ¡i¤H¤â·j¹L¡AMaterial ¦³³o­Ó¸ê®Æ, ¦ý¨S¦³¾É¥X¸ê®Æ¡j
¥»ÀÉ Bomªí E Äæ ¤¤¤å´y­z        Data Base ÀÉ Material ªíÄæ F ¤¤¤å´y­z(¹ï¨ÑÀ³°Ó)  ¡i¤H¤â·j¹L¡AMaterial ¦³³o­Ó¸ê®Æ, ¦ý¨S¦³¾É¥X¸ê®Æ¡j
¥»ÀÉ Bomªí F Äæ §÷½è, ¼Ð·Ç¤Îµ¥¯Å        Data Base ÀÉ Material ªíÄæ G §÷½è  ¡i¤H¤â·j¹L¡AMaterial ¦³³o­Ó¸ê®Æ, ¦ý¨S¦³¾É¥X¸ê®Æ¡j
¥»ÀÉ Bomªí H Äæ ³æ­«        Data Base ÀÉ Material ªíÄæ K ³æ­«  ¡i¤H¤â·j¹L¡AMaterial ¦³³o­Ó¸ê®Æ, ¦ý¨S¦³¾É¥X¸ê®Æ¡j
¥»ÀÉ Bomªí I Äæ 顔¦â/ªí­±³B²z        Data Base ÀÉ Material ªíÄæ J 顔¦â/ªí­±³B²z  ¡i¤H¤â·j¹L¡AMaterial ¦³³o­Ó¸ê®Æ, ¦ý¨S¦³¾É¥X¸ê®Æ¡j
¥»ÀÉ Bomªí K Äæ ³æ¦ì        Data Base ÀÉ Material ªíÄæ H ­^¤å³æ¦ì  ¡i¤H¤â·j¹L¡AMaterial ¦³³o­Ó¸ê®Æ, ¦ý¨S¦³¾É¥X¸ê®Æ¡j
¥»ÀÉ Bomªí N Äæ ±ÄÁʼƶq        ¥»ÀÉ Bomªí J Äæ ¼Æ¶q ¡i  ¤w¸Ñ¨M¡Aªþ¤W¥N½X¡j

Gasket ¼ÒªO        ¤U­±¥¼¾É¥X¸ê®Æ
¥»ÀÉ Gasket ªí D Äæ ­^¤å´y­z        Data Base ÀÉ Material ªíÄæ E ­^¤å´y­z(¹ï«È¤á) ¡i¤H¤â·j¹L¡AMaterial ¦³³o­Ó¸ê®Æ, ¦ý¨S¦³¾É¥X¸ê®Æ¡j
¥»ÀÉ Gasket ªí E Äæ ¤¤¤å´y­z        Data Base ÀÉ Material ªíÄæ F ¤¤¤å´y­z(¹ï¨ÑÀ³°Ó) ¡i¤H¤â·j¹L¡AMaterial ¦³³o­Ó¸ê®Æ, ¦ý¨S¦³¾É¥X¸ê®Æ¡j
¥»ÀÉ Gasket ªí H Äæ ³æ¦ì        Data Base ÀÉ Material ªíÄæ H ­^¤å³æ¦ì  ¡i¤H¤â·j¹L¡AMaterial ¦³³o­Ó¸ê®Æ, ¦ý¨S¦³¾É¥X¸ê®Æ¡j

Structural ¼ÒªO       
Á`®e¶q (L)        ªø«× * ºI­±¿n / 1000000 = Á`®e¶q ¡i§Ú¤w¸g­×§ï A(R, 7) = Application.RoundUp(A(R, 5) * A(R, 6) / 1000000, 0)¡j
ºI­±¿n(mm2) = ok        §÷®Æ´y­z 19.8mmx8mm ¡iºI­±¿n = 19.8 x 8 = 158.4, ³o­Ó¨S°ÝÃD¡j
ºI­±¿n(mm2) = ok        §÷®Æ´y­z25.4mmx8mm DC983 STRUCTURAL SILICONE-BLACK ¡iºI­±¿n = 25.4 x 8 = 203.2, ³o­Ó¨S°ÝÃD¡j
ºI­±¿n(mm2) = º|¤F³o­Ó³W«h        §÷®Æ´y­z136 mm² DC983 STRUCTURAL SILICONE-BLACK ¡i§÷®Æ´y­z¬O³oºØ mm² ´y­z¡AºI­±¿n = 136¡A³o­Ó¤§«e¨S¦³説©ú¡A»Ý­n¥[¤@¤U¡j
ºI­±¿n(mm2) = º|¤F³o­Ó³W«h        §÷®Æ´y­z176 mm² DC983 STRUCTURAL SILICONE-BLACK ¡i§÷®Æ´y­z¬O³oºØ mm² ´y­z¡AºI­±¿n = 176¡A³o­Ó¤§«e¨S¦³説©ú¡A»Ý­n¥[¤@¤U¡j

Fabrication Extrusion¼ÒªO        ¤U­±¾É¿ù¸ê®Æ
¥»ÀÉ Fabrication Extrusion ªí A3 Àx¦s®æ        ¥»ÀÉ Rule ªí H2 Àx¦s®æ ªº­^¤å¦r "Fabrication Order Sheet For Extrusion Parts" ¡]¡¨-¡§¤§«eªº­^¤å¦r¡^µ{¦¡¥X¨Óªº¬O ¡§Fabrication Order Sheet For Extrusion Parts - ¥[¤u¡¨
¥»ÀÉ Fabrication Extrusion ªí A4 Àx¦s®æ        ¥»ÀÉ Rule ªí H2 Àx¦s®æ ªº¤¤¤å¦r "¥[¤u²M³æ" ¡]¡¨-¡§¤§«áªº¤¤¤å¦r¡^µ{¦¡¥X¨Óªº¬O ¡§²M³æ¡¨
       
DN Material¼ÒªO        ¤U­±¾É¿ù¸ê®Æ
¥»ÀÉ DN Materialn ªí A3 Àx¦s®æ        ¥»ÀÉ Rule ªí E2 Àx¦s®æ ªº­^¤å¦r "Delivery Notes For Material Parts" ¡]¡¨-¡§¤§«eªº­^¤å¦r¡^µ{¦¡¥X¨Óªº¬O ¡§Delivery Notes For Material Parts - ´²¥ó¥X³f¡¨
¥»ÀÉ DN Material ªí A4 Àx¦s®æ        ¥»ÀÉ Rule ªí E2 Àx¦s®æ ªº¤¤¤å¦r "´²¥ó¥X³f©ú²Ó" ¡]¡¨-¡§¤§«áªº¤¤¤å¦r¡^µ{¦¡¥X¨Óªº¬O ¡§©ú²Ó¡¨
¥»ÀÉ DN Material ªí E Äæ ³æ­«        ¥»ÀÉ Part List ªíÄæ M ³æ­«  ¡i§Ú¤w¸g­×§ï A(R, 5) = Brr(i, 13)¡j
¥»ÀÉ DN Material ªí F Äæ ³æ¦ì        ="PC"  ¡i§Ú¤w¸g­×§ï A(R, 6) = "PC"¡j
¥»ÀÉ DN Material ªí H Äæ Á`­«¶q        ¥»ÀÉ DN Material ªí E Äæ ³æ­« * ¥»ÀÉ DN Material ªí G Äæ Á`¼Æ¶q ¡i§Ú¤w¸g­×§ï A(R, 8) = A(R, 5) * A(R, 7)¡j

198188

Bom ¼ÒªO        ¤U­±¥¼¾É¥X¸ê®Æ
¥»ÀÉ Bom ªí D Äæ ­^¤å´y­z        Data Base ÀÉ Material ªíÄæ E ­^¤å´y­z(¹ï«È¤á) ...
198188 µoªí©ó 2025-11-18 15:31

1. Sub RuleRun()
   
2. Dim T$, T2$, S$, i&, j%, T3$
   
3. Set Z = CreateObject("Scripting.Dictionary")
   
4. Brr = [Rule!A1].CurrentRegion
   
5. For i = 3 To UBound(Brr)
   
6.    For j = 2 To 8
   
7.       T = Brr(i, j)
   
8.       If T <> "" Then
   
9.          If Z(T & "|") = "" Or j = 5 Or j = 8 Then
   
10.             Z(T & "^") = Brr(2, j)
    
11.             [color=Red]Z(T & "|") = Left(Brr(2, j), InStr(Brr(2, j), "-") - 1)[/color]
    
12.          End If
    
13.          Exit For
    
14.       End If
    
15.    Next

½Æ»s¥N½X

1. Sub Structural()
   
2. If Brr(i, 1) = Brr(i - 1, 1) Then A(R, 5) = A(R, 5) + Brr(i, 3): Exit Sub
   
3. R = R + 1: A(R, 1) = R
   
4. For j = 0 To 2: A(R, Array(2, 3, 5)(j)) = Brr(i, Array(1, 2, 3)(j)): Next
   
5. If Brr(i, 2) Like "*mmx*" Then
   
6. L = Split(Brr(i, 2) & "mm", "mm")(0)
   
7. W = Split(Brr(i, 2) & "mm", "mm")(1)
   
8. L = Val(StrReverse(Mid(Val(StrReverse(L & 1)), 2)))
   
9. W = Val(StrReverse(Mid(Val(StrReverse(W & 1)), 2)))
   
10. A(R, 6) = L * W
    
11. Else
    
12. A(R, 6) = Split(Brr(i, 2) & "mm", "mm")(0)
    
13. End If
    
14. A(R, 8) = A(R, 5) * A(R, 6) / 1000
    
15. A(R, 7) = Application.RoundUp(A(R, 5) * A(R, 6) / 1000000, 0)
    
16. End Sub

½Æ»s¥N½X

Bom ¼ÒªO        ¤U­±¥¼¾É¥X¸ê®Æ
¥»ÀÉ Bom ªí D Äæ ­^¤å´y­z        Data Base ÀÉ Material ªíÄæ E ­^¤å´y­z(¹ï«È¤á)  ¡i¤H¤â·j¹L¡AMaterial ¦³³o­Ó¸ê®Æ, ¦ý¨S¦³¾É¥X¸ê®Æ¡j
¥»ÀÉ Bomªí E Äæ ¤¤¤å´y­z        Data Base ÀÉ Material ªíÄæ F ¤¤¤å´y­z(¹ï¨ÑÀ³°Ó)  ¡i¤H¤â·j¹L¡AMaterial ¦³³o­Ó¸ê®Æ, ¦ý¨S¦³¾É¥X¸ê®Æ¡j
¥»ÀÉ Bomªí F Äæ §÷½è, ¼Ð·Ç¤Îµ¥¯Å        Data Base ÀÉ Material ªíÄæ G §÷½è  ¡i¤H¤â·j¹L¡AMaterial ¦³³o­Ó¸ê®Æ, ¦ý¨S¦³¾É¥X¸ê®Æ¡j
¥»ÀÉ Bomªí H Äæ ³æ­«        Data Base ÀÉ Material ªíÄæ K ³æ­«  ¡i¤H¤â·j¹L¡AMaterial ¦³³o­Ó¸ê®Æ, ¦ý¨S¦³¾É¥X¸ê®Æ¡j
¥»ÀÉ Bomªí I Äæ 顔¦â/ªí­±³B²z        Data Base ÀÉ Material ªíÄæ J 顔¦â/ªí­±³B²z  ¡i¤H¤â·j¹L¡AMaterial ¦³³o­Ó¸ê®Æ, ¦ý¨S¦³¾É¥X¸ê®Æ¡j
¥»ÀÉ Bomªí K Äæ ³æ¦ì        Data Base ÀÉ Material ªíÄæ H ­^¤å³æ¦ì  ¡i¤H¤â·j¹L¡AMaterial ¦³³o­Ó¸ê®Æ, ¦ý¨S¦³¾É¥X¸ê®Æ¡j
¥»ÀÉ Bomªí N Äæ ±ÄÁʼƶq        ¥»ÀÉ Bomªí J Äæ ¼Æ¶q ¡i  ¤w¸Ñ¨M¡Aªþ¤W¥N½X¡j

Gasket ¼ÒªO        ¤U­±¥¼¾É¥X¸ê®Æ
¥»ÀÉ Gasket ªí D Äæ ­^¤å´y­z        Data Base ÀÉ Material ªíÄæ E ­^¤å´y­z(¹ï«È¤á) ¡i¤H¤â·j¹L¡AMaterial ¦³³o­Ó¸ê®Æ, ¦ý¨S¦³¾É¥X¸ê®Æ¡j
¥»ÀÉ Gasket ªí E Äæ ¤¤¤å´y­z        Data Base ÀÉ Material ªíÄæ F ¤¤¤å´y­z(¹ï¨ÑÀ³°Ó) ¡i¤H¤â·j¹L¡AMaterial ¦³³o­Ó¸ê®Æ, ¦ý¨S¦³¾É¥X¸ê®Æ¡j
¥»ÀÉ Gasket ªí H Äæ ³æ¦ì        Data Base ÀÉ Material ªíÄæ H ­^¤å³æ¦ì  ¡i¤H¤â·j¹L¡AMaterial ¦³³o­Ó¸ê®Æ, ¦ý¨S¦³¾É¥X¸ê®Æ¡j

Structural ¼ÒªO      
Á`®e¶q (L)        ªø«× * ºI­±¿n / 1000000 = Á`®e¶q ¡i§Ú¤w¸g­×§ï A(R, 7) = Application.RoundUp(A(R, 5) * A(R, 6) / 1000000, 0)¡j
ºI­±¿n(mm2) = ok        §÷®Æ´y­z 19.8mmx8mm ¡iºI­±¿n = 19.8 x 8 = 158.4, ³o­Ó¨S°ÝÃD¡j
ºI­±¿n(mm2) = ok        §÷®Æ´y­z25.4mmx8mm DC983 STRUCTURAL SILICONE-BLACK ¡iºI­±¿n = 25.4 x 8 = 203.2, ³o­Ó¨S°ÝÃD¡j
ºI­±¿n(mm2) = º|¤F³o­Ó³W«h        §÷®Æ´y­z136 mm² DC983 STRUCTURAL SILICONE-BLACK ¡i§÷®Æ´y­z¬O³oºØ mm² ´y­z¡AºI­±¿n = 136¡A³o­Ó¤§«e¨S¦³説©ú¡A»Ý­n¥[¤@¤U¡j ¡i  ¤w¸Ñ¨M¡Aªþ¤W¥N½X¡j
ºI­±¿n(mm2) = º|¤F³o­Ó³W«h        §÷®Æ´y­z176 mm² DC983 STRUCTURAL SILICONE-BLACK ¡i§÷®Æ´y­z¬O³oºØ mm² ´y­z¡AºI­±¿n = 176¡A³o­Ó¤§«e¨S¦³説©ú¡A»Ý­n¥[¤@¤U¡j ¡i  ¤w¸Ñ¨M¡Aªþ¤W¥N½X¡j

Fabrication Extrusion¼ÒªO        ¤U­±¾É¿ù¸ê®Æ
¥»ÀÉ Fabrication Extrusion ªí A3 Àx¦s®æ        ¥»ÀÉ Rule ªí H2 Àx¦s®æ ªº­^¤å¦r "Fabrication Order Sheet For Extrusion Parts" ¡]¡¨-¡§¤§«eªº­^¤å¦r¡^µ{¦¡¥X¨Óªº¬O ¡§Fabrication Order Sheet For Extrusion Parts - ¥[¤u¡¨¡i  ¤w¸Ñ¨M¡Aªþ¤W¥N½X¡j
¥»ÀÉ Fabrication Extrusion ªí A4 Àx¦s®æ        ¥»ÀÉ Rule ªí H2 Àx¦s®æ ªº¤¤¤å¦r "¥[¤u²M³æ" ¡]¡¨-¡§¤§«áªº¤¤¤å¦r¡^µ{¦¡¥X¨Óªº¬O ¡§²M³æ¡¨¡i  ¤w¸Ñ¨M¡Aªþ¤W¥N½X¡j
      
DN Material¼ÒªO        ¤U­±¾É¿ù¸ê®Æ
¥»ÀÉ DN Materialn ªí A3 Àx¦s®æ        ¥»ÀÉ Rule ªí E2 Àx¦s®æ ªº­^¤å¦r "Delivery Notes For Material Parts" ¡]¡¨-¡§¤§«eªº­^¤å¦r¡^µ{¦¡¥X¨Óªº¬O ¡§Delivery Notes For Material Parts - ´²¥ó¥X³f¡¨¡i  ¤w¸Ñ¨M¡Aªþ¤W¥N½X¡j
¥»ÀÉ DN Material ªí A4 Àx¦s®æ        ¥»ÀÉ Rule ªí E2 Àx¦s®æ ªº¤¤¤å¦r "´²¥ó¥X³f©ú²Ó" ¡]¡¨-¡§¤§«áªº¤¤¤å¦r¡^µ{¦¡¥X¨Óªº¬O ¡§©ú²Ó¡¨¡i  ¤w¸Ñ¨M¡Aªþ¤W¥N½X¡j
¥»ÀÉ DN Material ªí E Äæ ³æ­«        ¥»ÀÉ Part List ªíÄæ M ³æ­«  ¡i§Ú¤w¸g­×§ï A(R, 5) = Brr(i, 13)¡j
¥»ÀÉ DN Material ªí F Äæ ³æ¦ì        ="PC"  ¡i§Ú¤w¸g­×§ï A(R, 6) = "PC"¡j
¥»ÀÉ DN Material ªí H Äæ Á`­«¶q        ¥»ÀÉ DN Material ªí E Äæ ³æ­« * ¥»ÀÉ DN Material ªí G Äæ Á`¼Æ¶q ¡i§Ú¤w¸g­×§ï A(R, 8) = A(R, 5) * A(R, 7)¡j

Andy2483

¦^´_ 196# 198188


    BOMÃþ ¬dPart Listªí ¨ÑÀ³°Ó½s¸¹ ¤j³¡¤À³£¬O - ,©Ò¥H³£¤£¥²¦A¬d¤U¥h,©Ò¥H¨S¦³¤¤¤å/­^¤å´y­z¸ê®Æ

198188

¦^´_  198188


    BOMÃþ ¬dPart Listªí ¨ÑÀ³°Ó½s¸¹ ¤j³¡¤À³£¬O - ,©Ò¥H³£¤£¥²¦A¬d¤U¥h,©Ò¥H¨S¦³¤¤¤å/ ...
Andy2483 µoªí©ó 2025-11-18 16:44

BOM ªº¤¤­^¤å¦WºÙ ¦b Material ªí内¦³¡C
For j = 0 To 5: A(R, Array(4, 5, 6, 8, 9, 13)(j)) = Mrr(Z(A(R, 3) & "/m"), Array(5, 6, 7, 11, 10, 8)(j)): Next
For j = 0 To 2: A(R, Array(4, 5, 8)(j)) = Mrr(Z(A(R, 3) & "/m"), Array(5, 6, 8)(j)): Next
³o¨â¥y´N¬OµLªkŪ¨úMaterial ªíªº¸ê®Æ¡C

198188

¦^´_  198188


    BOMÃþ ¬dPart Listªí ¨ÑÀ³°Ó½s¸¹ ¤j³¡¤À³£¬O - ,©Ò¥H³£¤£¥²¦A¬d¤U¥h,©Ò¥H¨S¦³¤¤¤å/ ...
Andy2483 µoªí©ó 2025-11-18 16:44

1. Sub Bom()
   
2. If Brr(i, 1) = Brr(i - 1, 1) Then A(R, 10) = A(R, 10) + Brr(i, 3): A(R, 14) = A(R, 10): Exit Sub
   
3. R = R + 1: A(R, 1) = R: A(R, 2) = Brr(i, 1): A(R, 3) = Brr(i, 12)
   
4. If A(R, [color=Red]2[/color]) <> "" And Z.Exists(A(R, [color=Red]2[/color]) & "/m") Then
   
5.    For j = 0 To 5: A(R, Array(4, 5, 6, 8, 9, 11)(j)) = Mrr(Z(A(R, [color=Red]2[/color]) & "/m"), Array(5, 6, 7, 11, 10, 8)(j)): Next
   
6. End If
   
7. A(R, 7) = Brr(i, 4) & " x " & Brr(i, 5)
   
8. A(R, 10) = Brr(i, 3)
   
9. A(R, 14) = Brr(i, 3)
   
10. A(R, 18) = Brr(i, 7)
    
11. End Sub
    
12. 
    
13. Sub Gasket()
    
14. Dim T3$
    
15. If Brr(i, 1) = Brr(i - 1, 1) Then A(R, 9) = A(R, 9) + Brr(i, 3):   Exit Sub
    
16. R = R + 1: A(R, 1) = R
    
17. For j = 0 To 5: A(R, Array(2, 9, 6, 7, 11, 3)(j)) = Brr(i, Array(1, 3, 5, 6, 7, 12)(j)): Next
    
18. If A(R, [color=Red]2[/color]) <> "" And Z.Exists(A(R, [color=Red]2[/color]) & "/m") Then
    
19.    For j = 0 To 2: A(R, Array(4, 5, 8)(j)) = Mrr(Z(A(R, [color=Red]2[/color]) & "/m"), Array(5, 6, 8)(j)): Next
    
20. End If

½Æ»s¥N½X

«e½ú¡A §Ú§â A(R,3) §ï¦¨ A(R,2) ¤§«á¡ABOM & Gasket ³£¥i¥H¾É¥X Material ªº¸ê®Æ¡C ¦ý¬O°ß¿W HW--³o­Óªí¤£¦æ¡Aªþ¤W½d¨Ò¡C

Andy2483

¦^´_ 199# 198188


    ¤ñ¹ï«á¨S¦³¿ù»~
¥þ³¡ ¤¤¤å/­^¤å´y­zªÅ®æ,¨ä¥[¤u¥ó½s¸¹©Ò¹ïÀ³ªº ¨ÑÀ³°Ó½s¸¹³£¬OªÅ®æ

¤U¸ü (102.39 KB)

2025-11-19 08:49

A(R,3) §ï¦¨ A(R,2) ¤§«á¡ABOM & Gasket ³£¥i¥H¾É¥X Material ªº¸ê®Æ

¼ÒªO¥R¶ñ³W«h¸Ì¨S¦³»¡©ú¬O¥ÎPart Listªº ²Ä1Äæ(¥[¤u¥ó½s¸¹)¥h¬d Material ªí²Ä2Äæ (½s¸¹)Äæ,
«á¾Ç¯à°µªº´N¬O¥Î Part LIst (¥[¤u¥ó½s¸¹)¹ïÀ³ªº12Äæ(¨ÑÀ³°Ó½s¸¹)¥h¬d Materialªí§Ì3Äæ(¨ÑÀ³°Ó½s¸¹),
©Ò¥H Part LIst (¥[¤u¥ó½s¸¹)¹ïÀ³ªº12Äæ(¨ÑÀ³°Ó½s¸¹)¤j³¡¤À³£¬OªÅ®æ,·íµM´N¤£·|¦³ ¤¤¤å/­^¤å´y­z
¤è®×­×§ï¦p¤U:

Option Explicit
Public A, Z, R&, W, L, i&, Brr, Mrr, Q, Drr, j%, MyPath$
Sub Form()
Dim Arr, Crr(1 To 100000, 1 To 18), xW$, S, T$, T2$, Ts, xFile$, xBook As Workbook, Re
Ts = Timer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
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
Mrr = xBook.Sheets("Material").UsedRange
If Re = True Then xBook.Close 0
Call RuleRun

For i = 2 To UBound(Mrr): Z(Mrr(i, 2) & "/m") = i: Next
For i = Worksheets.Count To 1 Step -1
   If Z(Sheets(i).Name & "/s") <> "" Then Sheets(i).Delete
Next
If Sheets("Part List").FilterMode = True Then Sheets("Part List").ShowAllData
With Range(Sheets("Part List").[P1], Sheets("Part List").[A65536].End(3)(2))
   With .Columns(15): .Cells = "=ROW()": .Value = .Value: End With
   Brr = .Value
   ReDim Arr(1 To UBound(Brr) - 1, 1 To 1)
   For i = 2 To UBound(Brr)
      T = Left(Brr(i, 1), 2) & "-" & Brr(i, 7)
      If InStr("Y-O", Right(T, 1)) Then Arr(i - 1, 1) = Z(T)
   Next
   .Cells(2, 16).Resize(UBound(Brr) - 1, 1) = Arr
   .Sort KEY1:=.Item(16), Order1:=1, KEY2:=.Item(1), Order1:=1, Header:=1
   Brr = .Value
   .Sort KEY1:=.Item(15), Order1:=1, Header:=1
   .Cells(1, 15).Resize(, 2).EntireColumn.Delete
   A = Crr
   For i = 2 To UBound(Brr) - 1
      If Brr(i, 16) = "" Then Exit For Else T = Brr(i, 16)
      Run Replace(Z(T & "/s"), " ", "_")
      If T <> Brr(i + 1, 16) Then
         Sheets(Z(T & "/s")).Copy Before:=Sheets(1)
         ActiveSheet.Name = T
         With Cells(Z(Z(T & "/s") & "/UR"), 1).Resize(R, Z(Z(T & "/s") & "/UC"))
            .Value = A
            .Borders.LineStyle = xlContinuous
            ActiveSheet.PageSetup.PrintArea = Range([A1], .Cells).Address
         End With
         With Range(Z(Z(T & "/s") & "/V1")): .Value = Z(T & Switch(InStr("E0-Y E0--", T) Or InStr("WT", Right(T, 1)), "/RE", T = T, "/ER")): End With
         With Range(Z(Z(T & "/s") & "/V2")): .Value = Z(T & Switch(InStr("M4-- M4-Y IG--", T), "/EEC", InStr("E0-Y E0--", T) Or InStr("WT", Right(T, 1)), "/RC", T = T, "/EE")): End With
         With Range(Z(Z(T & "/s") & "/V3")): .Value = Z(T & "/EC"): .ShrinkToFit = True: End With
         A = Crr: R = 0
      End If
   Next
End With
ThisWorkbook.Activate
Set Z = Nothing
Erase Arr, Brr, Crr, A, Mrr
MsgBox Timer - Ts & " S"
End Sub

Sub RuleRun()
Dim T$, T2$, S$, i&, j%
Set Z = CreateObject("Scripting.Dictionary")
Brr = [Rule!A1].CurrentRegion
For i = 3 To UBound(Brr)
   For j = 2 To 8
      T = Brr(i, j)
      If T <> "" Then
         If Z(T & "|") = "" Or j = 5 Or j = 8 Then
            Z(T & "^") = Brr(2, j)
            Z(T & "|") = Trim(Mid(Brr(2, j), 1, Len(Brr(2, j)) * 2 - LenB(StrConv(Brr(2, j), vbFromUnicode)) - 2))
         End If
         Exit For
      End If
   Next
   For j = 11 To 28
      If Brr(i, j) = "" Then Exit For
      T2 = Brr(i, 11) & "-" & T
      Z(Brr(i, j) & "-" & T) = T2
      If Z(T2 & "/") = "" Then
         Z(T2 & "/") = Brr(i, 9) & "-" & Z(T & "|")
         Z(T2 & "/ER") = Z(T & "^")
         Z(T2 & "/EE") = Brr(i, 9)
         Z(T2 & "/EC") = Brr(i, 10)
         Z(T2 & "/EEC") = Brr(i, 9) & "/" & Brr(i, 10)
         Z(T2 & "/RC") = Trim(Replace(Replace(Z(T & "^"), Z(T & "|"), ""), "-", ""))
         Z(T2 & "/RE") = Z(T & "|")
      End If
      S = Brr(i, 1)
      Z(T2 & "/s") = S
      Z(S & "/UR") = Sheets(S).[A65536].End(3)(2).Row
      Z(S & "/UC") = Sheets(S).Cells(Z(S & "/UR") - 1, 256).End(xlToLeft).Column
      Z(S & "/V1") = Switch(S = "Bom", "L3", S = "Gasket", "D4", S = "Structural", "C4", S = "Fabrication Extrusion", "A3", S = "Finish", "A3", S = "DN Material", "A3")
      Z(S & "/V2") = Switch(S = "Bom", "A4", S = "Gasket", "D3", S = "Structural", "C3", S = "Fabrication Extrusion", "A4", S = "Finish", "A4", S = "DN Material", "A4")
      Z(S & "/V3") = Switch(S = "Bom", "A5", S = "Gasket", "E3", S = "Structural", "D3", S = "Fabrication Extrusion", "B3", S = "Finish", "B3", S = "DN Material", "B3")
   Next
Next
End Sub

Sub Bom()
If Brr(i, 1) = Brr(i - 1, 1) Then A(R, 10) = A(R, 10) + Brr(i, 3): Exit Sub
R = R + 1: A(R, 1) = R: A(R, 2) = Brr(i, 1) ': A(R, 3) = Brr(i, 12)
If A(R, 2) <> "" And Z.Exists(A(R, 2) & "/m") Then
   For j = 0 To 6
      A(R, Array(3, 4, 5, 6, 8, 9, 13)(j)) = Mrr(Z(A(R, 2) & "/m"), Array(3, 5, 6, 7, 11, 10, 8)(j))
   Next
End If
A(R, 7) = Brr(i, 4) & " x " & Brr(i, 5)
A(R, 10) = Brr(i, 3)
A(R, 18) = Brr(i, 7)
End Sub

Sub Gasket()
If Brr(i, 1) = Brr(i - 1, 1) Then A(R, 9) = A(R, 9) + Brr(i, 3):   Exit Sub
R = R + 1: A(R, 1) = R
For j = 0 To 4: A(R, Array(2, 9, 6, 7, 11)(j)) = Brr(i, Array(1, 3, 5, 6, 7)(j)): Next
If A(R, 2) <> "" And Z.Exists(A(R, 2) & "/m") Then
   For j = 0 To 3
      A(R, Array(3, 4, 5, 8)(j)) = Mrr(Z(A(R, 2) & "/m"), Array(3, 5, 6, 8)(j))
   Next
End If
End Sub

Sub Structural()
If Brr(i, 1) = Brr(i - 1, 1) Then A(R, 5) = A(R, 5) + Brr(i, 3): Exit Sub
R = R + 1: A(R, 1) = R
For j = 0 To 2: A(R, Array(2, 3, 5)(j)) = Brr(i, Array(1, 2, 3)(j)): Next
L = Split(Brr(i, 2) & "mm", "mm")(0)
W = Split(Brr(i, 2) & "mm", "mm")(1)
L = Val(StrReverse(Mid(Val(StrReverse(L & 1)), 2)))
W = Val(StrReverse(Mid(Val(StrReverse(W & 1)), 2)))
A(R, 6) = L * W
A(R, 8) = A(R, 5) * A(R, 6) / 1000
A(R, 7) = Application.RoundUp(A(R, 5) * A(R, 6) / 1000, 0)
End Sub

Sub DN_Material()
If Brr(i, 1) = Brr(i - 1, 1) Then A(R, 7) = A(R, 7) + Brr(i, 3):   Exit Sub
R = R + 1: A(R, 1) = R
For j = 0 To 2: A(R, Array(2, 4, 7)(j)) = Brr(i, Array(1, 5, 3)(j)): Next
If A(R, 2) <> "" And Z.Exists(A(R, 2) & "/m") Then
   A(R, 3) = Mrr(Z(A(R, 2) & "/m"), 3)
   A(R, 5) = Mrr(Z(A(R, 2) & "/m"), 11)
   A(R, 6) = Mrr(Z(A(R, 2) & "/m"), 8)
   A(R, 8) = A(R, 5) * A(R, 7)
End If
A(R, 9) = Brr(i, 7)
End Sub

Sub Fabrication_Extrusion()
If Brr(i, 1) = Brr(i - 1, 1) Then
   A(R, 6) = A(R, 6) + Brr(i, 3)
   Exit Sub
End If
R = R + 1: A(R, 1) = R
For j = 0 To 5: A(R, Array(2, 3, 4, 5, 6, 7)(j)) = Brr(i, Array(1, 11, 10, 4, 3, 1)(j)): Next
If A(R, 7) Like "*-*-*" Then
   Q = Split(A(R, 7), "-")
   A(R, 7) = Q(0) & "-" & Q(1)
End If
A(R, 8) = Brr(i, 7)
End Sub

Sub Finish()
If Brr(i, 1) = Brr(i - 1, 1) Then A(R, 5) = A(R, 5) + Brr(i, 5): Exit Sub
R = R + 1: A(R, 1) = R
For j = 0 To 4: A(R, Array(2, 3, 4, 5, 7)(j)) = Brr(i, Array(2, 3, 4, 5, 6)(j)): Next
End Sub