- ©«¤l
- 1478
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1502
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 100
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2025-10-23
|
¦^´_ 27# 198188
¥H¤U¤è®×½Ð¸Õ¸Õ¬Ý
Option Explicit
Sub TEST()
Dim Arr, Brr, Crr(1 To 10000, 1 To 18), A, V, Z, Q, S, i&, j%, R&, C%, y%, K, X%, T$, T1$, T2$, T3$, T4$, Rk$, W, L
Application.ScreenUpdating = False
Set Z = CreateObject("Scripting.Dictionary")
Brr = Range([Rule!X1], [Rule!E65536].End(3)(1, -3))
For i = 2 To 6
Z(Brr(i, 3) & "|") = Brr(i, 1)
Next
For i = 2 To UBound(Brr)
For j = 7 To 24
If Brr(i, j) = "" Then
If j = 8 Then
Z("/" & Brr(i, 5) & "/") = Brr(i, 7)
End If
Exit For
End If
Z("/" & Brr(i, j) & "/") = Brr(i, 5)
Z("/" & Brr(i, j) & "//") = Brr(i, 6)
Next
Next
Brr = Sheets("Á¿¸Ñ Rule").UsedRange
For i = 1 To UBound(Brr)
If Brr(i, 1) Like "³W«h#*¦rÀY¬O* ¤@¦Cªº*³Æª` ¬O*½Æ»s*" Then
S = InStr(Brr(i, 1), "¦rÀY¬O") + 3
T = Replace(Trim(Mid(Brr(i, 1), S, InStr(Brr(i, 1), " ¤@¦Cªº") - S)), "Hareware", "Hardware")
Rk = Trim(Mid(Brr(i, 1), InStr(Brr(i, 1), "³Æª` ¬O") + 5, 1))
S = InStr(Brr(i, 1), "½Æ»s ") + 4
S = Trim(Mid(Brr(i, 1), S, InStr(Brr(i, 1), " ªí®æ") - 1 - S))
Z(T & "\" & Rk) = 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
End If
If Brr(i, 1) Like "³W«h#*¦rÀY¬O ¥H¤WÂŦâ¦r¥À*²Õ¸Ë¹Ïªº¥X³f±¡ªp ¬O*½Æ»s*" Then
Rk = Trim(Mid(Brr(i, 1), InStr(Brr(i, 1), "±¡ªp ¬O") + 5, 1))
S = InStr(Brr(i, 1), "½Æ»s ") + 4
S = Trim(Mid(Brr(i, 1), S, InStr(Brr(i, 1), " ªí®æ") - 1 - S))
For y = 1 To 100
If Brr(i - y, 2) = "" Then Exit For Else T = Brr(i - y, 2)
Z(Z("/" & T & "/") & "\" & Rk) = 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
Next
End If
Next
Arr = Sheets("Material").UsedRange
For i = 2 To UBound(Arr)
Z(Arr(i, 3) & "/m") = i
Next
Brr = Range(Sheets("Part List").[M1], Sheets("Part List").[A65536].End(3))
For i = 2 To UBound(Brr)
T = Z("/" & Left(Brr(i, 1), 2) & "/")
T4 = Z("/" & Left(Brr(i, 1), 2) & "//")
Rk = Brr(i, 7)
T2 = Z(T & "\" & Rk)
T3 = T & "-" & Z(Rk & "|")
If Len(T3) > 31 Then '¤u§@ªí¦W>31¦r(§ï¥H¤¤¤åªí¥Ü)
T3 = T4 & "-" & Z(Rk & "|")
End If
Z("|" & T3) = T2
A = Z("/" & T3)
R = Z("r/" & T3)
If Not IsArray(A) Then
A = Crr
End If
If T2 = "Bom" Then
R = R + 1
A(R, 1) = R
A(R, 2) = Brr(i, 1)
A(R, 3) = Brr(i, 12)
If A(R, 3) <> "" Then
A(R, 4) = Arr(Z(A(R, 3) & "/m"), 5)
A(R, 5) = Arr(Z(A(R, 3) & "/m"), 6)
A(R, 6) = Arr(Z(A(R, 3) & "/m"), 7)
A(R, 8) = Arr(Z(A(R, 3) & "/m"), 11)
A(R, 9) = Arr(Z(A(R, 3) & "/m"), 10)
A(R, 13) = Arr(Z(A(R, 3) & "/m"), 8)
End If
A(R, 7) = Brr(i, 4) & " x " & Brr(i, 5)
A(R, 10) = Brr(i, 3)
A(R, 18) = Brr(i, 7)
GoTo i01
End If
If T2 = "Gasket" Then
R = R + 1
A(R, 1) = R
A(R, 2) = Brr(i, 1)
A(R, 9) = Brr(i, 3)
A(R, 6) = Brr(i, 5)
A(R, 7) = Brr(i, 6)
A(R, 11) = Brr(i, 7)
A(R, 3) = Brr(i, 12)
If A(R, 3) <> "" Then
A(R, 4) = Arr(Z(A(R, 3) & "/m"), 5)
A(R, 5) = Arr(Z(A(R, 3) & "/m"), 6)
A(R, 8) = Arr(Z(A(R, 3) & "/m"), 8)
End If
GoTo i01
End If
If T2 = "Structural" Then
R = R + 1
A(R, 1) = R
A(R, 2) = Brr(i, 1)
A(R, 3) = Brr(i, 2)
A(R, 5) = Brr(i, 3)
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)
GoTo i01
End If
If T2 = "DN Material" Then '
R = R + 1
A(R, 1) = R
A(R, 2) = Brr(i, 1)
A(R, 3) = Brr(i, 12)
A(R, 4) = Brr(i, 5)
A(R, 7) = Brr(i, 3)
If A(R, 3) <> "" Then
A(R, 5) = Arr(Z(A(R, 3) & "/m"), 11)
A(R, 6) = Arr(Z(A(R, 3) & "/m"), 8)
A(R, 6) = A(R, 5) * A(R, 7)
End If
A(R, 9) = Brr(i, 7)
GoTo i01
End If
If T2 = "Fabrication Extrusion" Then
R = R + 1
A(R, 1) = R
A(R, 2) = Brr(i, 1)
A(R, 3) = Brr(i, 11)
A(R, 4) = Brr(i, 10)
A(R, 5) = Brr(i, 4)
A(R, 6) = Brr(i, 3)
A(R, 7) = Brr(i, 1)
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 If
i01: Z("/" & T3) = A
Z("r/" & T3) = R
Next
Brr = Range(Sheets("Frame per Dwg").[M1], Sheets("Frame per Dwg").[A65536].End(3))
For i = 2 To UBound(Brr)
T = Z("/" & Left(Brr(i, 2), 2) & "/")
T4 = Z("/" & T & "/")
Rk = Brr(i, 6)
T2 = Z(T & "\" & Rk)
T3 = T4 & "-" & Z(Rk & "|")
Z("|" & T3) = T2
A = Z("/" & T3)
R = Z("r/" & T3)
If Not IsArray(A) Then
A = Crr
End If
If T2 = "Finish" Then
R = R + 1
A(R, 1) = R
A(R, 2) = Brr(i, 2)
A(R, 3) = Brr(i, 3)
A(R, 4) = Brr(i, 4)
A(R, 5) = Brr(i, 5)
A(R, 7) = Brr(i, 6)
End If
Z("/" & T3) = A
Z("r/" & T3) = R
Next
Workbooks.Add
Q = ActiveWorkbook.Name
For Each K In Z.Keys
If IsArray(Z(K)) And Z("r" & K) > 0 Then
T = Mid(K, 2)
ThisWorkbook.Sheets(Z("|" & T)).Copy Before:=Workbooks(Q).Sheets(1)
ActiveSheet.Name = T
With Cells(Z(Z("|" & T) & "/UR"), 1).Resize(Z("r" & K), Z(Z("|" & T) & "/UC"))
.Value = Z(K)
.Borders.LineStyle = xlContinuous
End With
End If
Next
End Sub |
|