Andy2483

¦^´_ 20# 198188


Àx¦s®æO1ªº1.35 §ï¬°1.3 ¸Õ¸Õ¬Ý
§Ú§Ñ°O¤F²Å骩·|¶Ã½X¡A¤£¼vÅT°õ¦æ´N¨SÃö¨t

198188

¦^´_ 21# Andy2483


    ¦b­þ­Ó¦ì¸m¡A¦]爲¶Ã½X¡A§Ú¤À¿ì¤£¥X¡C

Andy2483

¦^´_ 22# 198188


    Àx¦s®æO1
¦bªí®æªºO1¤W¬O1.35§ï¬° 1.3 ¸Õ¸Õ¬Ý

¤U¸ü (94.37 KB)

2024-2-21 07:07

Option Explicit
Sub TEST()
Dim Brr(1 To 100, 1 To 14), A, Z, Q, P, i&, j%, R&, C%, N&, x%, T$, T14$, T15$, T5$, V8&, V9&, V10#, Tp1$, Tp3$, Tp5$, Y&, SS$, Tts#
Dim PGNr, Rackr, Itemr, PGr, DPLs As Worksheet, xR As Range, xRs As Range, TT$, TH#, ii, RH, Sh#, xRc As Range, xRe As Range
Set Z = CreateObject("Scripting.Dictionary"): Application.ScreenUpdating = False: Application.DisplayAlerts = False: Sh = Rows(17).RowHeight / 32
Tts = [O1]: PGNr = [PGN!A1].CurrentRegion: Rackr = [Rack!A1].CurrentRegion: Itemr = [Item!A1].CurrentRegion: PGr = [PG!A1].CurrentRegion
Set DPLs = Sheets("DPL"): DPLs.Activate: T = [J3]: DPLs.UsedRange.Offset(19).EntireRow.Delete: Set xR = [A20]
Cells.VerticalAlignment = xlCenter: ActiveSheet.ResetAllPageBreaks: [A1].Activate: For i = 1 To 19: TH = TH + Rows(i).RowHeight: Next
For i = 2 To UBound(PGr)
   If Z(PGr(i, 1) & "^") = "" Then Z(PGr(i, 1) & "^") = PGr(i, 2) Else MsgBox "PGªí " & PGr(i, 1) & " ­«½Æ": Exit Sub
Next
For i = 2 To UBound(Rackr)
   If Rackr(i, 11) <> T Then GoTo i01
   T14 = Rackr(i, 14): T5 = Rackr(i, 5): T15 = Rackr(i, 15)
   If Not Z.Exists(T15) Then R = N Mod 3 + 1: C = N \ 3: N = N + 1: Brr(R, Array(1, 3, 4)(C)) = T15: Z(T15) = ""
   If InStr("," & Z(T14 & "/GD") & ",", "," & T15 & ",") = 0 Then Z(T14 & "/GD") = Z(T14 & "/GD") & "," & T15
   If InStr("," & Z(T14 & "/RN") & ",", "," & T5 & ",") = 0 Then Z(T14 & "/RN") = Z(T14 & "/RN") & "," & T5: Z(T5 & "|") = i Else MsgBox "Rackªí " & T5 & " ­«½Æ": Exit Sub
i01: Next
DPLs.[G12].Resize(3, 4) = Brr: DPLs.[G15] = "TOTAL " & N & " X 45'HC CONTAINER": N = 0
For i = 2 To UBound(PGNr)
   If PGNr(i, 1) <> T Then GoTo i02
   If Z.Exists(PGNr(i, 2) & "/GD") Then Z(PGNr(i, 2) & "/GD") = "CONTAINER NO.:" & Mid(Z(PGNr(i, 2) & "/GD"), 2) & vbCrLf & PGNr(i, 3)
i02: Next
For i = 2 To UBound(Itemr)
   If Z.Exists(Itemr(i, 3) & "|") Then Z(Itemr(i, 3) & "|") = Z(Itemr(i, 3) & "|") & "," & i
Next
For Each A In Z.KEYS
   If Right(A, 3) <> "/RN" Then GoTo A01 Else Q = Split(Z(A), ","): xR = Z(Split(A, "/RN")(0) & "/GD")
   With xR.Resize(, 14): .Merge: .Font.Size = 9: .Font.Bold = True: .Rows.RowHeight = 52 * Sh: End With
   For i = 1 To UBound(Q)
      Set xR = xR(2): xR.Resize(1, 14).Interior.ColorIndex = 15: xR.Resize(1, 14).Font.Bold = True: xR.Rows.RowHeight = 27 * Sh
      With xR.Resize(1, 4): .Merge: .Font.Size = 12:  .Value = "'" & Q(i): End With
      xR(1, 6).Resize(, 2).Merge: xR(1, 10).Resize(, 5).Merge
      P = Split(Z(Q(i) & "|"), ","): R = Val(P(0))
      xR(1, 8) = Val(Rackr(R, 6)): xR(1, 9) = Val(Rackr(R, 7)): xR(1, 10) = Rackr(R, 8) & " x " & Rackr(R, 9) & " x " & Rackr(R, 10)
      V8 = V8 + xR(1, 8): V9 = V9 + xR(1, 9): V10 = V10 + (Val(Rackr(R, 8)) * Val(Rackr(R, 9)) * Val(Rackr(R, 10)) / 10 ^ 9): Set xRs = xR(2, 8): Set xRs = xR(2, 1)
      For j = 1 To UBound(P)
         Tp1 = Itemr(P(j), 5): Tp3 = Z(Itemr(P(j), 6) & "^"): Tp5 = Itemr(P(j), 4)
         Y = Z(Q(i) & "/" & Tp1 & "/" & Tp3 & "/" & Tp5)
         If Y = 0 Then
            Set xR = xR(2): xR.Resize(1, 14).Font.Size = 9: xR = Tp1: xR(1, 3) = Tp3: xR(1, 5) = Tp5: xR(1, 6) = Val(Itemr(P(j), 7))
            Z(Q(i) & "/" & Tp1 & "/" & Tp3 & "/" & Tp5) = xR.Row: xR.Rows.RowHeight = 27 * Sh: GoTo j01
         End If
         Cells(Y, 6) = Cells(Y, 6) + Val(Itemr(P(j), 7))
j01:  Next
      With Range(xRs, xR(1, 14))
         .Sort KEY1:=.Item(6), Order1:=1, Header:=2: .Sort KEY1:=.Item(5), Order1:=1, Key2:=.Item(3), Order2:=1, Key3:=.Item(1), Order2:=1, Header:=2
         For R = 1 To .Rows.Count: .Cells(R, 1).Resize(1, 2).Merge: .Cells(R, 3).Resize(1, 2).Merge: .Cells(R, 6).Resize(1, 2).Merge: .Cells(R, 8).Resize(1, 7).Merge: Next
      End With
   Next
   Set xR = xR(2)
A01: Next
Cells.VerticalAlignment = xlCenter: If ActiveSheet.VPageBreaks.Count + 1 = 2 Then ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
xR(1, 5) = "TOTAL": xR.Resize(, 4).Merge: xR(1, 5).Resize(, 3).Merge: xR(1, 8) = V8: xR(1, 9) = V9: xR(1, 10) = Round(V10, 2): xR(1, 10).Resize(1, 5).Merge: xR.Rows.RowHeight = 27 * Sh
With xR.Resize(1, 14): .Font.Size = 12: .Font.Bold = True: End With
ActiveSheet.Names.Add Name:="PrintArea", RefersTo:=Range([A1], xR(, 14)): ActiveSheet.PageSetup.PrintArea = "PrintArea"
For i = 20 To xR.Row '800-327.3=472.7 : 472.7/327.3=1.44
   TT = Cells(i, 3) & "/" & Cells(i, 5)
   If TT = "/" Then GoTo i03
   If TT = SS Or SS = "" Then
      If xRc Is Nothing Then Set xRc = Cells(i, 3): Set xRe = Cells(i, 5) Else Set xRc = Union(xRc, Cells(i, 3)): Set xRe = Union(xRe, Cells(i, 5))
   End If
i03: RH = RH + Cells(i, 1).RowHeight
   If Cells(i + 1, 3) & "/" & Cells(i + 1, 5) <> TT Or RH / TH > Tts Then
      If Not xRc Is Nothing Then
         If xRc.Count > 1 Then With Intersect(xRc, xRc.Offset(1)): .Merge: .Value = "": End With: xRe.Merge: xRe.VerticalAlignment = xlTop: xRc.Offset(, 5).Merge
      End If
      Set xRc = Nothing: Set xRe = Nothing: SS = Cells(i + 1, 3) & "/" & Cells(i + 1, 5)
   End If
   If RH / TH > Tts Then Cells(i + 1, 1).PageBreak = xlPageBreakManual: RH = 0
Next
Intersect(Range("PrintArea"), Range("PrintArea").Offset(19)).Borders.LineStyle = 1
Set Z = Nothing: Erase PGNr, Rackr, Itemr, PGr: Set xR = Nothing: Set xRs = Nothing: Set xRc = Nothing: Set xRe = Nothing
End Sub

198188

¦^´_ 23# Andy2483


    ¥i¥H¤F¡AÁÂÁ¡C

¥t¥~¦³­Ó°ÝÃD¡A§Ú¥Î¿ý»s¤è¦¡¼g¤F¤@­ÓVBA ¬O¦bªþ¥óùثإߨâ­Ó¼Ï¯Ã¤ÀªRªí¡C¤£¹L¹B¦æªº®É­Ô¦b¤U­±³o­Ó¦ì¸m¥d¦í¤F¡C   ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "sheet1!R1C1:R1048576C12", Version:=8).CreatePivotTable TableDestination:= _
        "sheet1!R1C26", TableName:="PivotTable21", DefaultVersion:=8
½ÐÀ°§Ú¬Ý¬Ý¬O­þùØ¥X²{°ÝÃD¡C
¥t¥~¯à¤£¯àÀ°¦£§ï¨}¤@¤U¡A
1) ÄæZ -AAªº¼Ï¯Ã¤ÀªRªí
¸ê®Æ¨Ó·½±qA1  - L1  :  A (ÄæB³Ì«á¤@¦æ¡^ -  L(ÄæB³Ì«á¤@¦æ¡^
Äæ¦ì²M³æ¡G
¦C ¡G SECTION & LENGTH
­È ¡G ¥[Á`QTY

2) ÄæAC-ADªº¼Ï¯Ã¤ÀªRªí
¸ê®Æ¨Ó·½±qN1  - V1  :  N (ÄæP³Ì«á¤@¦æ¡^ -  V(ÄæP³Ì«á¤@¦æ¡^
Äæ¦ì²M³æ¡G
¦C ¡G SECTION & LENGTH
­È ¡G ¥[Á`Q'TY

Sub Macro2()
  Application.CutCopyMode = False
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "sheet1!R1C1:R1048576C12", Version:=8).CreatePivotTable TableDestination:= _
        "sheet1!R1C26", TableName:="PivotTable21", DefaultVersion:=8
    Sheets("sheet1)").Select
    Cells(1, 26).Select
    With ActiveSheet.PivotTables("PivotTable21")
        .ColumnGrand = True
        .HasAutoFormat = True
        .DisplayErrorString = False
        .DisplayNullString = True
        .EnableDrilldown = True
        .ErrorString = ""
        .MergeLabels = False
        .NullString = ""
        .PageFieldOrder = 2
        .PageFieldWrapCount = 0
        .PreserveFormatting = True
        .RowGrand = True
        .SaveData = True
        .PrintTitles = False
        .RepeatItemsOnEachPrintedPage = True
        .TotalsAnnotation = False
        .CompactRowIndent = 1
        .InGridDropZones = False
        .DisplayFieldCaptions = True
        .DisplayMemberPropertyTooltips = False
        .DisplayContextTooltips = True
        .ShowDrillIndicators = True
        .PrintDrillIndicators = False
        .AllowMultipleFilters = False
        .SortUsingCustomLists = True
        .FieldListSortAscending = False
        .ShowValuesRow = False
        .CalculatedMembersInFilters = False
        .RowAxisLayout xlCompactRow
    End With
    With ActiveSheet.PivotTables("PivotTable21").PivotCache
        .RefreshOnFileOpen = False
        .MissingItemsLimit = xlMissingItemsDefault
    End With
    ActiveSheet.PivotTables("PivotTable21").RepeatAllLabels xlRepeatLabels
    ActiveWorkbook.ShowPivotTableFieldList = True
    With ActiveSheet.PivotTables("PivotTable21").PivotFields("SECTION")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable21").PivotFields("LENGTH")
        .Orientation = xlRowField
        .Position = 2
    End With
    ActiveSheet.PivotTables("PivotTable21").AddDataField ActiveSheet.PivotTables( _
        "PivotTable21").PivotFields("QTY"), "Count of QTY", xlCount
    With ActiveSheet.PivotTables("PivotTable21").PivotFields("Count of QTY")
        .Caption = "Sum of QTY"
        .Function = xlSum
    End With
    ActiveWorkbook.ShowPivotTableFieldList = False
End Sub

Andy2483

¦^´_ 24# 198188


    ÁÂÁ«e½ú¦^´_
¦Ü©ó·s´£¥Xªº¼Ï¯Ã°ÝÃD»Ý¨D»P¦¹¥DÃD®t²§¤j,«Øij«e½ú¦AµZ¿i¤@¤U,¦pªGÁÙ¨Sªk¸Ñ¨M ¥tµo·s¸ÜÃDµ¹ª©¤W«e½ú¤@°_°µ¥æ¬y

198188

¦^´_ 25# Andy2483


    ¦nªº¡AÁÂÁ¡C

Andy2483

¦^´_ 24# 198188

ÁÂÁ½׾Â,ÁÂÁ«e½ú
¤µ¤Ñ½Æ²ß¤F¤@¤U,¾Ç²ß¤ß±o¦p¤U,½Ð«e½ú°Ñ¦Ò,½Ð¦U¦ì«e½ú«ü±Ð
§tµù¸Ñ¦r¼Æ¤Ó¦h¤À¦¨¨â­¶
Option Explicit
Sub TEST()
Dim Brr(1 To 100, 1 To 14), A, Z, Q, P, i&, j%, R&, C%, N&, x%, T$, T14$, T15$, T5$, V8&, V9&, V10#, Tp1$, Tp3$, Tp5$, Y&, SS$, Tts#
Dim PGNr, Rackr, Itemr, PGr, DPLs As Worksheet, xR As Range, xRs As Range, TT$, TH#, RH, Sh#, xRc As Range, xRe As Range
'¡ô«Å§iÅܼÆ,%¬Oµu¾ã¼Æ,&¬Oªø¾ã¼Æ,$¬O¦r¦êÅܼÆ,#¬OÂùºë«×¤p¼Æ,As Range¬OÀx¦s®æÅܼÆ,As Worksheet¬O¤u§@ªíÅܼÆ,¨ä¥¦¨S¦³«ü©wªº¬O³q¥Î«¬ÅܼÆ
Set Z = CreateObject("Scripting.Dictionary"): Application.ScreenUpdating = False: Application.DisplayAlerts = False: Sh = Rows(17).RowHeight / 32
'¡ô¥OZÅܼƬO ¦r¨å:¥O¿Ã¹õ¼È¤£ÀHµ{§Ç°µÅܤÆ:¥Oµ{§Ç¤£­n¸õ¥X(¦X¨ÖÀx¦s®æ¥u¯d¥ª¤W®æ¤º®e)ªº¸ß°Ýµ¡,¥OShÅܼƬO²Ä17¦C¦C°ª/32 ­È
Tts = [O1]: PGNr = [PGN!A1].CurrentRegion: Rackr = [Rack!A1].CurrentRegion: Itemr = [Item!A1].CurrentRegion: PGr = [PG!A1].CurrentRegion
'¡ô¥OTtsÅܼƬO[O1]Àx¦s®æ­È,¥OPGNrÅܼƬO¤u§@ªí("PGN").[A1]Àx¦s®æ¬Û¾F¦êÁp«áÂX®i¦¨ªº³Ì¤p¤è¥¿°Ï°ìÀx¦s®æ­È±a¤Jªº¤Gºû°}¦C,Rackr/Itemr/PGrÅܼƨ̦¹Ãþ±À
Set DPLs = Sheets("DPL"): DPLs.Activate: T = [J3]: DPLs.UsedRange.Offset(19).EntireRow.Delete: Set xR = [A20]
'¡ô¥ODPLsÅܼƬO¤u§@ªí("DPL"),¥ODPLs¿E¬¡,¥OT³o¦r¦êÅܼƬO[J3]Àx¦s®æ­È(Invoice No),¥OªíÀY¥H¤Uªº¸ê®Æ¦C¾ã¦C§R°£,¥OxR³oÀx¦s®æÅܼƬO [A20]Àx¦s®æ
Cells.VerticalAlignment = xlCenter: ActiveSheet.ResetAllPageBreaks: [A1].Activate: For i = 1 To 19: TH = TH + Rows(i).RowHeight: Next
'¡ô¥O¥þ³¡Àx¦s®æ®æ¦¡««ª½¦V¤å¦r¸m¤¤,¥O²M°£¤À­¶½u,¥O´å¼Ð¸õ¨ì[A1],³]¶¶°j°é±N1¨ì19¦Cªº¦C°ª¬Û¥[µ¹ THÅܼÆ
For i = 2 To UBound(PGr)
'¡ô³]¶¶°j°é!¥Oi±q2 ¨ìPGr°}¦C³Ì¤j¯Á¤Þ¦C¸¹
   If Z(PGr(i, 1) & "^") = "" Then Z(PGr(i, 1) & "^") = PGr(i, 2) Else MsgBox "PGªí " & PGr(i, 1) & " ­«½Æ": Exit Sub
   '¡ô¦pªGi°j°é¦C1ÄæPGr°}¦C­È³s±µ"^"²Å¸¹©Ò²Õ¦¨ªº·s¦r¦ê¬dZ¦r¨å¦^¶Çitem¬OªÅ¦r¤¸!´N¥O¨äitem­È¬O i°j°é¦C2ÄæPGr°}¦C­È,
   '§_«h¥NªíPGªíªº¹ï·Ó¸ê®Æ¦³­«½Æ, ¸õ¥X´£¥Üµ¡~~,³Ì«áµ²§ôµ{¦¡°õ¦æ
Next
For i = 2 To UBound(Rackr)
'¡ô³]¶¶°j°é!¥Oi±q2 ¨ìRackr°}¦C³Ì¤j©Ò¤Þ¦C¸¹
   If Rackr(i, 11) <> T Then GoTo i01
   '¡ô¦pªGi°j°é¦C11ÄæRackr°}¦C­È¤£¦P©óTÅܼÆ(Invoice No),´N¸õ¨ì¼Ð¥Üi01¦ì¸mÄ~Äò°õ¦æ
   T14 = Rackr(i, 14): T5 = Rackr(i, 5): T15 = Rackr(i, 15)
   '¡ô¥OT14³o¦r¦êÅܼƬOi°j°é¦C14ÄæRackr°}¦C­È,T5/T15¨Ì¦¹³W«hÃþ±À
   If Not Z.Exists(T15) Then R = N Mod 3 + 1: C = N \ 3: N = N + 1: Brr(R, Array(1, 3, 4)(C)) = T15: Z(T15) = ""
   '¡ô¦pªGZ¦r¨å¸Ì¨S¦³T15ÅܼÆkey!´N¥ORÅܼƭȬO(NÅܼư£3ªº¾l¼Æ+1),¥ONÅܼƲ֥[1,¥OT15ÅܼƼg¤JBrr°}¦C¤¤,¥OT15¦bZ¦r¨å¹ïÀ³item¬OªÅ¦r¤¸
   If InStr("," & Z(T14 & "/GD") & ",", "," & T15 & ",") = 0 Then Z(T14 & "/GD") = Z(T14 & "/GD") & "," & T15
   '¡ô¦pªGT14ÅܼƳs±µ"/GD"¦r¦ê©Ò²Õ¦¨·s¦r¦êkey¬dZ¦r¨å±oitem­È¦AÀY§À³s±µ³r¸¹©Ò²Õ¦¨ªº·s¦r¦ê¸Ì¨S¦³ T15ÅܼÆÀY§À³s±µ³r¸¹©Ò²Õ¦¨ªº·s¦r¦ê!
   '´N¥O¸Óitem¦r¦ê¥H³r¸¹³s±µT15Åܼƫá,©ñ¦^Z¦r¨å¤¤
   If InStr("," & Z(T14 & "/RN") & ",", "," & T5 & ",") = 0 Then Z(T14 & "/RN") = Z(T14 & "/RN") & "," & T5: Z(T5 & "|") = i Else MsgBox "Rackªí " & T5 & " ­«½Æ": Exit Sub
   '¡ô¦pªGT14ÅܼƳs±µ"/RN"¦r¦ê©Ò²Õ¦¨·s¦r¦êkey¬dZ¦r¨å±oitem­È¦AÀY§À³s±µ³r¸¹©Ò²Õ¦¨ªº·s¦r¦ê¸Ì¨S¦³ T5ÅܼÆÀY§À³s±µ³r¸¹©Ò²Õ¦¨ªº·s¦r¦ê!
   '´N¥O¸Óitem¦r¦ê¥H³r¸¹³s±µT5Åܼƫá,©ñ¦^Z¦r¨å¤¤,¥OT5ÅܼƳs±µ"|"²Å¸¹©Ò²Õ¦¨ªº·s¦r¦ê·íkey,item¬O¦C¸¹,¯Ç¤JZ¦r¨å¤¤,
   '§_«h¥NªíRack¤u§@ªí ²Ä5Äæ¸ÌªºRack Number¦³­«½Æ,¥O¸õ¥X´£µøµ¡~~~,,³Ì«áµ²§ôµ{¦¡°õ¦æ
i01: Next
DPLs.[G12].Resize(3, 4) = Brr: DPLs.[G15] = "TOTAL " & N & " X 45'HC CONTAINER": N = 0
'¡ô¥ODPLsÅܼÆ[G12]Àx¦s®æÂX®i¦V¤U3¦C,¦V¥kÂX®i4Äæ½d³òªºÀx¦s®æ­È¥HBrr°}¦C­È¼g¤J
For i = 2 To UBound(PGNr)
'¡ô³]¶¶°j°é!¥Oi±q2 ¨ìPGNr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
   If PGNr(i, 1) <> T Then GoTo i02
   '¡ô¦pªGi°j°é¦C1ÄæPNGr°}¦C­È¤£¦P©óTÅܼÆ(Invoice No),´N¸õ¨ì¼Ð¥Üi02¦ì¸mÄ~Äò°õ¦æ
   If Z.Exists(PGNr(i, 2) & "/GD") Then Z(PGNr(i, 2) & "/GD") = "CONTAINER NO.:" & Mid(Z(PGNr(i, 2) & "/GD"), 2) & vbCrLf & PGNr(i, 3)
   '¡ô¦pªGi°j°é¦C2ÄæPNGr°}¦C­È³s±µ"/GD"¦r¦ê©Ò²Õ¦¨ªº·s¦r¦ê¦bZ¦r¨å¸Ì¦³¦¹key!´N¥Oitem´«¬°·s²Õ¦X¦¨ªº¦r¦ê
i02: Next
For i = 2 To UBound(Itemr)
'¡ô³]¶¶°j°é!¥Oi±q2 ¨ìItemr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
   If Z.Exists(Itemr(i, 3) & "|") Then Z(Itemr(i, 3) & "|") = Z(Itemr(i, 3) & "|") & "," & i
   '¡ô¦pªG¥Hi°j°é¦C3ÄæItemr°}¦C­È³s±µ"|"²Å¸¹©Ò²Õ¦¨ªº·s¦r¦ê¬dZ¦r¨å¦³¦¹key!´N¥Oitem¥H³r¸¹³s±µiÅܼÆ(¦C¸¹)²Õ¦¨·s¦r¦ê©ñ¦^Z¦r¨å¤¤
Next

Andy2483

For Each A In Z.KEYS
'¡ô³]³v¶µ°j°é!¥OAÅܼƬOZ¦r¨å¤¤ªºkey
   If Right(A, 3) <> "/RN" Then GoTo A01 Else Q = Split(Z(A), ","): xR = Z(Split(A, "/RN")(0) & "/GD")
   '¡ô¦pªGAÅܼƥk3¦r¤£¬O"/RN"¦r¦ê!´N¥Oµ{§Ç¸õ¨ì¼Ð¥ÜA01¦ì¸mÄ~Äò°õ¦æ,
   '§_«h´N¥OQÅܼƬO¥H³r¸¹¤À³Î¦r¦ê(¥HAÅܼƬdZ¦r¨å¦^¶Çªº¦r¦ê)©Ò§Î¦¨ªº¤@ºû°}¦C,¥OxRÀx¦s®æ­È¬O¬dZ¦r¨å¦^¶Ç­È
   With xR.Resize(, 14): .Merge: .Font.Size = 9: .Font.Bold = True: .Rows.RowHeight = 52 * Sh: End With
   '¡ô¥OCONTAINER NO¼ÐÃD®æ¦X¨Ö,¤å¦r¤j¤p9,³]¤å¦r²ÊÅé,¦C°ª52­Ó³æ¦ì
   For i = 1 To UBound(Q)
   '¡ô³]¶¶°j°é!¥Oi±q1 ¨ìQ°}¦C³Ì¤j¯Á¤Þ¸¹
      Set xR = xR(2): xR.Resize(1, 14).Interior.ColorIndex = 15: xR.Resize(1, 14).Font.Bold = True: xR.Rows.RowHeight = 27 * Sh
      '¡ô¥OxRÀx¦s®æÅܬ°¤U¤@®æ,¥O±qxRÀx¦s®æ¥kÂX®i14®æ½d³òÀx¦s®æ©³¦â¬°¦Ç¦â/¤å¦r¬°²ÊÅé,¦C°ª27­Ó³æ¦ì
      With xR.Resize(1, 4): .Merge: .Font.Size = 12:  .Value = "'" & Q(i): End With
      '¡ô¥O±qxRÀx¦s®æ¥kÂX®i14®æ½d³òÀx¦s®æ¦X¨Ã/¤å¦r¤j¤p12/¥O¤å¦r¤º®e¬°i°j°éQ°}¦C­È(«e­±¥[³æ¤Þ¸¹¬O¥O±j¨î¨ä¬°¤å¦r)
      xR(1, 6).Resize(, 2).Merge: xR(1, 10).Resize(, 5).Merge
      '¡ô¥O¬q¸¨Àx¦s®æ¦X¨Ö
      P = Split(Z(Q(i) & "|"), ","): R = Val(P(0))
      '¡ô¥OPÅܼƬO¥H³r¸¹¤À³Î¦r¨å¸Ì°O¿ýªºItemªí¦C¸¹¦ê,¥ORÅܼƬORackªíªº¦C¸¹
      xR(1, 8) = Val(Rackr(R, 6)): xR(1, 9) = Val(Rackr(R, 7)): xR(1, 10) = Rackr(R, 8) & " x " & Rackr(R, 9) & " x " & Rackr(R, 10)
      '¡ô¥O¦ÛxRÀx¦s®æ¥k8®æ(H)Àx¦s®æ­È¬ORÅܼƦC6ÄæRackr°}¦C­È,¥O¦ÛxRÀx¦s®æ¥k9®æ(I)Àx¦s®æ­È¬ORÅܼƦC9ÄæRackr°}¦C­È,
      '¥O¦ÛxRÀx¦s®æ¥k10®æ(H)Àx¦s®æ­È¬ORÅܼƦC8/9/10ÄæRackr°}¦C­È¥H"x"²Å¸¹³s±µ©Ò²Õ¦¨ªº·s¦r¦ê
      V8 = V8 + xR(1, 8): V9 = V9 + xR(1, 9): V10 = V10 + (Val(Rackr(R, 8)) * Val(Rackr(R, 9)) * Val(Rackr(R, 10)) / 10 ^ 9): Set xRs = xR(2, 1)
      '¡ô¥OV8ÅܼƲ֥[ ¦ÛxRÀx¦s®æ¥k8®æ(H)Àx¦s®æ­È,¥OV9ÅܼƲ֥[ ¦ÛxRÀx¦s®æ¥k9®æ(H)Àx¦s®æ­È,¥OV10ÅܼƬOªø*¼e*°ª­È,¥OxRsÅܼƬOxRÀx¦s®æªº¤U¤@®æÀx¦s®æ
      For j = 1 To UBound(P)
      '¡ô³]¶¶°j°é!¥OjÅܼƱq1 ¨ìP°}¦C³Ì¤j¯Á¤Þ¸¹
         Tp1 = Itemr(P(j), 5): Tp3 = Z(Itemr(P(j), 6) & "^"): Tp5 = Itemr(P(j), 4)
         '¡ô¥OTp1¬O ItemªíItem Number­È,¥OTp3¬O¥H ItemªíItem Description Group­È¹ï·ÓGPªí±o¨ìªº Description
         Y = Z(Q(i) & "/" & Tp1 & "/" & Tp3 & "/" & Tp5)
         '¡ô¥OYÅܼƬO 5­ÓÃöÁä¦r¦ê¥H"/"²Å¸¹³s±µ°_¨Óªº¦r¦ê¬dZ¦r¨å¦^¶Ç­È
         If Y = 0 Then
         '¡ô¦pªGYÅܼƬO 0
            Set xR = xR(2): xR.Resize(1, 14).Font.Size = 9: xR = Tp1: xR(1, 3) = Tp3: xR(1, 5) = Tp5: xR(1, 6) = Val(Itemr(P(j), 7))
            '¡ô¥OxRÀx¦s®æÅܧ󬰤U¤@®æÀx¦s®æ,¥O±qxRÀx¦s®æ¥kÂX®i14®æ½d³òÀx¦s®æ¤å¦r¤j¤p9,¥OxRÀx¦s®æ­È¬O Tp1ÅܼƭÈ,¥OxRÀx¦s®æ¥k3®æ­È¬O Tp3ÅܼƭÈ,
            '¥OxRÀx¦s¥k5®æ­È¬O Tp5ÅܼƭÈ,¥OxRÀx¦s¥k6®æ­È¬O Itemªíªº Quantity­È
            Z(Q(i) & "/" & Tp1 & "/" & Tp3 & "/" & Tp5) = xR.Row: xR.Rows.RowHeight = 27 * Sh: GoTo j01
            '¡ô¥OYÅܼƬO 5­ÓÃöÁä¦r¦ê¥H"/"²Å¸¹³s±µ°_¨Óªº¦r¦ê·íkey,item¬OxRÀx¦s®æ¦C¸¹,¥OxRÀx¦s®æ·í¦C¦C°ª¬O27­Ó³æ¦ì,¥O¸õ¨ì¼Ð¥Üj01¦ì¸mÄ~Äò°õ¦æ
         End If
         Cells(Y, 6) = Cells(Y, 6) + Val(Itemr(P(j), 7))
         '¡ô¥OYÅܼƦCFÄæÀx¦s®æ­È²Ö¥[ Itemªíªº Quantity­È
j01:  Next
      With Range(xRs, xR(1, 14))
      '¡ô¥H¤U¬OÃö©óxRsÀx¦s®æ¦Ü xRÀx¦s®æ¥k14®æ¤§¶¡½d³òÀx¦s®æ
         .Sort KEY1:=.Item(6), Order1:=1, Header:=2: .Sort KEY1:=.Item(5), Order1:=1, Key2:=.Item(3), Order2:=1, Key3:=.Item(1), Order2:=1, Header:=2
         '¡ô¥O¸Ó½d³òÀx¦s®æ°µ¤T¼h¦¸µL¼ÐÃDªº¶¶±Æ§Ç
         For R = 1 To .Rows.Count: .Cells(R, 1).Resize(1, 2).Merge: .Cells(R, 3).Resize(1, 2).Merge: .Cells(R, 6).Resize(1, 2).Merge: .Cells(R, 8).Resize(1, 7).Merge: Next
         '¡ô³]¶¶°j°é!¥ORÅܼƱq1 ¨ì¸Ó°Ï°ìªº¦C¼Æ,¥O¦U°Ï¬qÀx¦s®æ¦X¨Ö
      End With
   Next
   Set xR = xR(2)
   '¡ô¥OxRÀx¦s®æÅܧ󬰤U¤@®æÀx¦s®æ
A01: Next
Cells.VerticalAlignment = xlCenter: If ActiveSheet.VPageBreaks.Count + 1 = 2 Then ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
'¡ô¥O¥þ³¡Àx¦s®æ®æ¦¡««ª½¤è¦V¤å¦r¸m¤¤,'¡ô¦pªG¦C¦L½d³òªº¾î¦V­¶¼Æ¬O2! ´N¥OÁa¦V¤À­¶½u²¾¦Ü³Ì¥k°¼,Åý¾î¦V­¶¼Æ¬O1,¦Û°Ê½Õ¾ã¨ä¥L°t¦X¦C¦L°Ñ¼Æ
https://forum.twbts.com/viewthread.php?tid=19505
xR(1, 5) = "TOTAL": xR.Resize(, 4).Merge: xR(1, 5).Resize(, 3).Merge: xR(1, 8) = V8: xR(1, 9) = V9: xR(1, 10) = Round(V10, 2): xR(1, 10).Resize(1, 5).Merge: xR.Rows.RowHeight = 27 * Sh
'¡ô¥OxRÀx¦s®æ¥k5®æÀx¦s®æ­È¬O "TOTAL" ¦r¦ê,«e4®æ½d³ò¦X¨ÖÀx¦s®æ,¥k5®æ¶}©lÂX®i¥k3®æ½d³ò¦X¨ÖÀx¦s®æ,¥O¶ñ¤J²Î­p­È¨Ã¥B¦X¨ÖÀx¦s®æ,¥O¦C°ª¬O27­Ó³æ¦ì
With xR.Resize(1, 14): .Font.Size = 12: .Font.Bold = True: End With
'¡ô¥OxRÀx¦s®æÂX®i¥k14®æ½d³ò¤å¦r¤j¤p¬°12 / ²ÊÅé
ActiveSheet.Names.Add Name:="PrintArea", RefersTo:=Range([A1], xR(, 14)): ActiveSheet.PageSetup.PrintArea = "PrintArea"
'¡ô¥OÀx¦s®æ½d³ò«Ø¥ß¦WºÙ¬° "PrintArea",¥O¦C¦L½d³ò¬°¦WºÙ "PrintArea"
For i = 20 To xR.Row '800-327.3=472.7 : 472.7/327.3=1.44
'¡ô³]¶¶°j°é¥OiÅܼƱq20¨ì xRÀx¦s®æ¦C¸¹
   TT = Cells(i, 3) & "/" & Cells(i, 5)
   '¡ô¥OTTÅܼƬOi°j°é¦CCÄæ­È»Pi°j°é¦CEÄæ­È¥H"/"²Å¸¹³s±µ²Õ¦¨ªº·s¦r¦ê
   If TT = "/" Then GoTo i03
   '¡ô¦pªGTTÅܼƬO "/"²Å¸¹!´N¥Oµ{§Ç¸õ¨ì¼Ð¥Üi03¦ì¸mÄ~Äò°õ¦æ
   If TT = SS Or SS = "" Then
   '¡ô¦pªGTTÅܼƦPSSÅÜ¼Æ ©ÎSSÅܼƬOªÅ¦r¤¸??
      If xRc Is Nothing Then Set xRc = Cells(i, 3): Set xRe = Cells(i, 5) Else Set xRc = Union(xRc, Cells(i, 3)): Set xRe = Union(xRe, Cells(i, 5))
      '¡ô¦pªGxRcÀx¦s®æ¬OªÅªº!´N¥OxRcÀx¦s®æ¬Oi°j°é¦CCÄæÀx¦s®æ,¥OxReÀx¦s®æ¬Oi°j°é¦CEÄæÀx¦s®æ,
      '§_«h´N¥Oi°j°é¦CCÄæÀx¦s®æ¯Ç¤JxRcÀx¦s®æ¶°¤§¤¤,¥Oi°j°é¦CEÄæÀx¦s®æ¯Ç¤JxReÀx¦s®æ¶°¤§¤¤
   End If
i03: RH = RH + Cells(i, 1).RowHeight
     '¡ô¥ORHÅܼƲ֥[°j°é¦C°ª
   If Cells(i + 1, 3) & "/" & Cells(i + 1, 5) <> TT Or RH / TH > Tts Then
   '¡ô¦pªG(i+1)°j°é¦CCÄæ­È»P(i+1)°j°é¦CEÄæ­È¥H"/"²Å¸¹³s±µ²Õ¦¨ªº·s¦r¦ê¤£¦P©ó TTÅܼƩΠRHÅܼư£¥HTHÅܼƪº°Ó > TtsÅܼÆ??
      If Not xRc Is Nothing Then
      '¡ô¦pªGxRcÀx¦s®æ¦³ª«¥ó??
         If xRc.Count > 1 Then With Intersect(xRc, xRc.Offset(1)): .Merge: .Value = "": End With: xRe.Merge: xRe.VerticalAlignment = xlTop: xRc.Offset(, 5).Merge
         '¡ô¦pªGxRcÀx¦s®æ¼Æ¤j©ó1!´N¥OxRcÀx¦s®æ¶°°Ï°ì²Ä1¦C(¤£§t)¥H¤UªºÀx¦s®æ°µ¦X¨Ö,¥OxReÀx¦s®æ¶°°µ¦X¨Ö,¤å¦r°¾¤W
      End If
      Set xRc = Nothing: Set xRe = Nothing: SS = Cells(i + 1, 3) & "/" & Cells(i + 1, 5)
      '¡ô¥OxRc xReÅܼƲMªÅ,¥OSSÅܼƬO (i+1)°j°é¦CCÄæ­È»P(i+1)°j°é¦CEÄæ­È¥H"/"²Å¸¹³s±µ²Õ¦¨ªº·s¦r¦ê
   End If
   If RH / TH > Tts Then Cells(i + 1, 1).PageBreak = xlPageBreakManual: RH = 0
   '¡ô¦pªGRH / TH°Ó¤j©ó Tts!´N¥O¦bi+1¦C³]©w¤À­¶½u,¥ORHÅܼÆÂk¹s
Next
Intersect(Range("PrintArea"), Range("PrintArea").Offset(19)).Borders.LineStyle = 1
'¡ô¥OªíÀY¥H¥~ªº¸ê®Æ®æ³]©w²Ó®Ø½u
Set Z = Nothing: Erase PGNr, Rackr, Itemr, PGr: Set xR = Nothing: Set xRs = Nothing: Set xRc = Nothing: Set xRe = Nothing
End Sub

198188

¦^´_ 28# Andy2483


    ÁÂÁ¡A«e½ú«üÂI¡C

198188

¤U¸ü (44.89 KB)

2024-2-26 09:36

¦^´_ 28# Andy2483


§Ú¤µ¤Ñ¸Õ¤F¤@­Ó·sªº¡A¥X²{¬õ¦â³¡¤Àªº°ÝÃD¡C
¥ªÃä¶Â¦â¦rªº¬OVBA°õ¦æ¥X¨Óªº¡A¥kÃ䪺¬O·Q­nªºµ²ªG¡C