Andy2483

回復 24# 198188


    謝謝前輩回復
至於新提出的樞紐問題需求與此主題差異大,建議前輩再琢磨一下,如果還沒法解決 另發新話題給版上前輩一起做交流

Andy2483

回復 24# 198188

謝謝論壇,謝謝前輩
今天複習了一下,學習心得如下,請前輩參考,請各位前輩指教
含註解字數太多分成兩頁
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
'↑宣告變數,%是短整數,&是長整數,$是字串變數,#是雙精度小數,As Range是儲存格變數,As Worksheet是工作表變數,其它沒有指定的是通用型變數
Set Z = CreateObject("Scripting.Dictionary"): Application.ScreenUpdating = False: Application.DisplayAlerts = False: Sh = Rows(17).RowHeight / 32
'↑令Z變數是 字典:令螢幕暫不隨程序做變化:令程序不要跳出(合併儲存格只留左上格內容)的詢問窗,令Sh變數是第17列列高/32 值
Tts = [O1]: PGNr = [PGN!A1].CurrentRegion: Rackr = [Rack!A1].CurrentRegion: Itemr = [Item!A1].CurrentRegion: PGr = [PG!A1].CurrentRegion
'↑令Tts變數是[O1]儲存格值,令PGNr變數是工作表("PGN").[A1]儲存格相鄰串聯後擴展成的最小方正區域儲存格值帶入的二維陣列,Rackr/Itemr/PGr變數依此類推
Set DPLs = Sheets("DPL"): DPLs.Activate: T = [J3]: DPLs.UsedRange.Offset(19).EntireRow.Delete: Set xR = [A20]
'↑令DPLs變數是工作表("DPL"),令DPLs激活,令T這字串變數是[J3]儲存格值(Invoice No),令表頭以下的資料列整列刪除,令xR這儲存格變數是 [A20]儲存格
Cells.VerticalAlignment = xlCenter: ActiveSheet.ResetAllPageBreaks: [A1].Activate: For i = 1 To 19: TH = TH + Rows(i).RowHeight: Next
'↑令全部儲存格格式垂直向文字置中,令清除分頁線,令游標跳到[A1],設順迴圈將1到19列的列高相加給 TH變數
For i = 2 To UBound(PGr)
'↑設順迴圈!令i從2 到PGr陣列最大索引列號
   If Z(PGr(i, 1) & "^") = "" Then Z(PGr(i, 1) & "^") = PGr(i, 2) Else MsgBox "PG表 " & PGr(i, 1) & " 重複": Exit Sub
   '↑如果i迴圈列1欄PGr陣列值連接"^"符號所組成的新字串查Z字典回傳item是空字元!就令其item值是 i迴圈列2欄PGr陣列值,
   '否則代表PG表的對照資料有重複, 跳出提示窗~~,最後結束程式執行
Next
For i = 2 To UBound(Rackr)
'↑設順迴圈!令i從2 到Rackr陣列最大所引列號
   If Rackr(i, 11) <> T Then GoTo i01
   '↑如果i迴圈列11欄Rackr陣列值不同於T變數(Invoice No),就跳到標示i01位置繼續執行
   T14 = Rackr(i, 14): T5 = Rackr(i, 5): T15 = Rackr(i, 15)
   '↑令T14這字串變數是i迴圈列14欄Rackr陣列值,T5/T15依此規則類推
   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) = ""
   '↑如果Z字典裡沒有T15變數key!就令R變數值是(N變數除3的餘數+1),令N變數累加1,令T15變數寫入Brr陣列中,令T15在Z字典對應item是空字元
   If InStr("," & Z(T14 & "/GD") & ",", "," & T15 & ",") = 0 Then Z(T14 & "/GD") = Z(T14 & "/GD") & "," & T15
   '↑如果T14變數連接"/GD"字串所組成新字串key查Z字典得item值再頭尾連接逗號所組成的新字串裡沒有 T15變數頭尾連接逗號所組成的新字串!
   '就令該item字串以逗號連接T15變數後,放回Z字典中
   If InStr("," & Z(T14 & "/RN") & ",", "," & T5 & ",") = 0 Then Z(T14 & "/RN") = Z(T14 & "/RN") & "," & T5: Z(T5 & "|") = i Else MsgBox "Rack表 " & T5 & " 重複": Exit Sub
   '↑如果T14變數連接"/RN"字串所組成新字串key查Z字典得item值再頭尾連接逗號所組成的新字串裡沒有 T5變數頭尾連接逗號所組成的新字串!
   '就令該item字串以逗號連接T5變數後,放回Z字典中,令T5變數連接"|"符號所組成的新字串當key,item是列號,納入Z字典中,
   '否則代表Rack工作表 第5欄裡的Rack Number有重複,令跳出提視窗~~~,,最後結束程式執行
i01: Next
DPLs.[G12].Resize(3, 4) = Brr: DPLs.[G15] = "TOTAL " & N & " X 45'HC CONTAINER": N = 0
'↑令DPLs變數[G12]儲存格擴展向下3列,向右擴展4欄範圍的儲存格值以Brr陣列值寫入
For i = 2 To UBound(PGNr)
'↑設順迴圈!令i從2 到PGNr陣列縱向最大索引列號
   If PGNr(i, 1) <> T Then GoTo i02
   '↑如果i迴圈列1欄PNGr陣列值不同於T變數(Invoice No),就跳到標示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)
   '↑如果i迴圈列2欄PNGr陣列值連接"/GD"字串所組成的新字串在Z字典裡有此key!就令item換為新組合成的字串
i02: Next
For i = 2 To UBound(Itemr)
'↑設順迴圈!令i從2 到Itemr陣列縱向最大索引列號
   If Z.Exists(Itemr(i, 3) & "|") Then Z(Itemr(i, 3) & "|") = Z(Itemr(i, 3) & "|") & "," & i
   '↑如果以i迴圈列3欄Itemr陣列值連接"|"符號所組成的新字串查Z字典有此key!就令item以逗號連接i變數(列號)組成新字串放回Z字典中
Next

Andy2483

For Each A In Z.KEYS
'↑設逐項迴圈!令A變數是Z字典中的key
   If Right(A, 3) <> "/RN" Then GoTo A01 Else Q = Split(Z(A), ","): xR = Z(Split(A, "/RN")(0) & "/GD")
   '↑如果A變數右3字不是"/RN"字串!就令程序跳到標示A01位置繼續執行,
   '否則就令Q變數是以逗號分割字串(以A變數查Z字典回傳的字串)所形成的一維陣列,令xR儲存格值是查Z字典回傳值
   With xR.Resize(, 14): .Merge: .Font.Size = 9: .Font.Bold = True: .Rows.RowHeight = 52 * Sh: End With
   '↑令CONTAINER NO標題格合併,文字大小9,設文字粗體,列高52個單位
   For i = 1 To UBound(Q)
   '↑設順迴圈!令i從1 到Q陣列最大索引號
      Set xR = xR(2): xR.Resize(1, 14).Interior.ColorIndex = 15: xR.Resize(1, 14).Font.Bold = True: xR.Rows.RowHeight = 27 * Sh
      '↑令xR儲存格變為下一格,令從xR儲存格右擴展14格範圍儲存格底色為灰色/文字為粗體,列高27個單位
      With xR.Resize(1, 4): .Merge: .Font.Size = 12:  .Value = "'" & Q(i): End With
      '↑令從xR儲存格右擴展14格範圍儲存格合並/文字大小12/令文字內容為i迴圈Q陣列值(前面加單引號是令強制其為文字)
      xR(1, 6).Resize(, 2).Merge: xR(1, 10).Resize(, 5).Merge
      '↑令段落儲存格合併
      P = Split(Z(Q(i) & "|"), ","): R = Val(P(0))
      '↑令P變數是以逗號分割字典裡記錄的Item表列號串,令R變數是Rack表的列號
      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)
      '↑令自xR儲存格右8格(H)儲存格值是R變數列6欄Rackr陣列值,令自xR儲存格右9格(I)儲存格值是R變數列9欄Rackr陣列值,
      '令自xR儲存格右10格(H)儲存格值是R變數列8/9/10欄Rackr陣列值以"x"符號連接所組成的新字串
      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)
      '↑令V8變數累加 自xR儲存格右8格(H)儲存格值,令V9變數累加 自xR儲存格右9格(H)儲存格值,令V10變數是長*寬*高值,令xRs變數是xR儲存格的下一格儲存格
      For j = 1 To UBound(P)
      '↑設順迴圈!令j變數從1 到P陣列最大索引號
         Tp1 = Itemr(P(j), 5): Tp3 = Z(Itemr(P(j), 6) & "^"): Tp5 = Itemr(P(j), 4)
         '↑令Tp1是 Item表Item Number值,令Tp3是以 Item表Item Description Group值對照GP表得到的 Description
         Y = Z(Q(i) & "/" & Tp1 & "/" & Tp3 & "/" & Tp5)
         '↑令Y變數是 5個關鍵字串以"/"符號連接起來的字串查Z字典回傳值
         If Y = 0 Then
         '↑如果Y變數是 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))
            '↑令xR儲存格變更為下一格儲存格,令從xR儲存格右擴展14格範圍儲存格文字大小9,令xR儲存格值是 Tp1變數值,令xR儲存格右3格值是 Tp3變數值,
            '令xR儲存右5格值是 Tp5變數值,令xR儲存右6格值是 Item表的 Quantity值
            Z(Q(i) & "/" & Tp1 & "/" & Tp3 & "/" & Tp5) = xR.Row: xR.Rows.RowHeight = 27 * Sh: GoTo j01
            '↑令Y變數是 5個關鍵字串以"/"符號連接起來的字串當key,item是xR儲存格列號,令xR儲存格當列列高是27個單位,令跳到標示j01位置繼續執行
         End If
         Cells(Y, 6) = Cells(Y, 6) + Val(Itemr(P(j), 7))
         '↑令Y變數列F欄儲存格值累加 Item表的 Quantity值
j01:  Next
      With Range(xRs, xR(1, 14))
      '↑以下是關於xRs儲存格至 xR儲存格右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
         '↑設順迴圈!令R變數從1 到該區域的列數,令各區段儲存格合併
      End With
   Next
   Set xR = xR(2)
   '↑令xR儲存格變更為下一格儲存格
A01: Next
Cells.VerticalAlignment = xlCenter: If ActiveSheet.VPageBreaks.Count + 1 = 2 Then ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
'↑令全部儲存格格式垂直方向文字置中,'↑如果列印範圍的橫向頁數是2! 就令縱向分頁線移至最右側,讓橫向頁數是1,自動調整其他配合列印參數
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
'↑令xR儲存格右5格儲存格值是 "TOTAL" 字串,前4格範圍合併儲存格,右5格開始擴展右3格範圍合併儲存格,令填入統計值並且合併儲存格,令列高是27個單位
With xR.Resize(1, 14): .Font.Size = 12: .Font.Bold = True: End With
'↑令xR儲存格擴展右14格範圍文字大小為12 / 粗體
ActiveSheet.Names.Add Name:="PrintArea", RefersTo:=Range([A1], xR(, 14)): ActiveSheet.PageSetup.PrintArea = "PrintArea"
'↑令儲存格範圍建立名稱為 "PrintArea",令列印範圍為名稱 "PrintArea"
For i = 20 To xR.Row '800-327.3=472.7 : 472.7/327.3=1.44
'↑設順迴圈令i變數從20到 xR儲存格列號
   TT = Cells(i, 3) & "/" & Cells(i, 5)
   '↑令TT變數是i迴圈列C欄值與i迴圈列E欄值以"/"符號連接組成的新字串
   If TT = "/" Then GoTo i03
   '↑如果TT變數是 "/"符號!就令程序跳到標示i03位置繼續執行
   If TT = SS Or SS = "" Then
   '↑如果TT變數同SS變數 或SS變數是空字元??
      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))
      '↑如果xRc儲存格是空的!就令xRc儲存格是i迴圈列C欄儲存格,令xRe儲存格是i迴圈列E欄儲存格,
      '否則就令i迴圈列C欄儲存格納入xRc儲存格集之中,令i迴圈列E欄儲存格納入xRe儲存格集之中
   End If
i03: RH = RH + Cells(i, 1).RowHeight
     '↑令RH變數累加迴圈列高
   If Cells(i + 1, 3) & "/" & Cells(i + 1, 5) <> TT Or RH / TH > Tts Then
   '↑如果(i+1)迴圈列C欄值與(i+1)迴圈列E欄值以"/"符號連接組成的新字串不同於 TT變數或 RH變數除以TH變數的商 > Tts變數??
      If Not xRc Is Nothing Then
      '↑如果xRc儲存格有物件??
         If xRc.Count > 1 Then With Intersect(xRc, xRc.Offset(1)): .Merge: .Value = "": End With: xRe.Merge: xRe.VerticalAlignment = xlTop: xRc.Offset(, 5).Merge
         '↑如果xRc儲存格數大於1!就令xRc儲存格集區域第1列(不含)以下的儲存格做合併,令xRe儲存格集做合併,文字偏上
      End If
      Set xRc = Nothing: Set xRe = Nothing: SS = Cells(i + 1, 3) & "/" & Cells(i + 1, 5)
      '↑令xRc xRe變數清空,令SS變數是 (i+1)迴圈列C欄值與(i+1)迴圈列E欄值以"/"符號連接組成的新字串
   End If
   If RH / TH > Tts Then Cells(i + 1, 1).PageBreak = xlPageBreakManual: RH = 0
   '↑如果RH / TH商大於 Tts!就令在i+1列設定分頁線,令RH變數歸零
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

Andy2483

回復 30# 198188

謝謝前輩回復
增加 檢查"PGN"表資料是否有 Invoice No,執行結果

下載 (95.69 KB)

2024-2-26 11:06

For i = 2 To UBound(PGNr)
   Z(PGNr(i, 1)) = "/" '20240226新增
   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)
   End If
i02: Next
If Z(T) <> "/" Then MsgBox "PGN表沒有 " & T & " 項目": Exit Sub   '20240226新增
For i = 2 To UBound(Itemr)
   If Z.Exists(Itemr(i, 3) & "|") Then Z(Itemr(i, 3) & "|") = Z(Itemr(i, 3) & "|") & "," & i
Next

Andy2483

回復 33# 198188


    PGN表裡就是沒有 C864-2024 這資料,不知所云

Andy2483

回復 30# 198188


    宣告裡的 V8&, V9& 改為 V8#, V9#

Andy2483

回復 37# 198188

H欄整欄選取右鍵 >儲存格格式:

下載 (137.13 KB)

2024-2-26 15:33

至於合計10,請自己試試,27#有註解,一起學習

Andy2483

回復 39# 198188

厲害,以下紅字也要加,另外我的H欄整欄(連同後方的空格)選取變更格式為小數兩位後,執行就會帶小數889.00,請再試試
For j = 1 To UBound(P)
         Tp1 = Itemr(P(j), 5): Tp3 = Z(Itemr(P(j), 6) & "^"): Tp5 = Itemr(P(j), 4): W = W + Itemr(P(j), 7)
         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)): W = W + Itemr(P(j), 7)
j01:  Next

Andy2483

回復 41# 198188


    錄製巨集試試看,很多代碼都可以錄製後再簡化就可以用了