返回列表 上一主題 發帖

讀取及歸類及框綫格式

讀取及歸類及框綫格式

附件是一個多工作頁的互相抽取資料的模式,讀取后牽涉一些框綫,空格格式等問題,請各大大幫忙看看有沒有方法解決,謝謝。

VBA FORM.rar (116.72 KB)

附件是一個多工作頁的互相抽取資料的模式,讀取后牽涉一些框綫,空格格式等問題,請各大大幫忙看看有 ...
198188 發表於 2024-2-6 11:19



   附上拆分清單格式構思,希望能夠給各位大大更加容易理解。

Detail Packing List Print Query.rar (12.04 KB)

TOP

回復 1# 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&
Dim PGNr, Rackr, Itemr, PGr, DPLs As Worksheet, xR As Range, xRs As Range, xRe As Range
Set Z = CreateObject("Scripting.Dictionary"): Application.ScreenUpdating = False
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]: xR.Resize(1000, 14).Borders.LineStyle = 1
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) ': MsgBox Z(PGNr(i, 2) & "/GD")
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: 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
      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 xRe = 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: GoTo j01
         End If
         Cells(Y, 6) = Cells(Y, 6) + Val(Itemr(P(j), 7))
j01:  Next
      With Range(xRe, 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: Next
      End With
      Range(xRs, xR(1, 14)).Merge
   Next
   Set xR = xR(2)
A01: Next
Set xR = xR(2): xR(1, 5) = "TOTAL": xR(1, 8) = V8: xR(1, 9) = V9: xR(1, 10) = V10: xR(1, 10).Resize(1, 5).Merge
With xR.Resize(1, 14): .Font.Size = 12: .Font.Bold = True: End With
Set Z = Nothing: Erase PGNr, Rackr, Itemr, PGr
End Sub

祝各位前輩 新春愉快
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

附上拆分清單格式構思,希望能夠給各位大大更加容易理解。
198188 發表於 2024-2-7 10:20



    同篇問題 建議 用修改 或是 回覆.. 不然很亂

  多做多想多學習,少看少錯少迷途

  多做=多多練習,多多編寫。
  多想=想想為什麼人家程式要那樣寫,如果換成自己,又會怎寫。
  多學習=學習人家的發問並解答,學習人家的寫法

  少看=只看不做也枉然

TOP

回復 3# Andy2483


謝謝您的解答,試過結果后,有附件注釋,方便清晰規則。
另外可否在VBA加上注釋,方便學習,謝謝。

VBA FORM R01.rar (128.06 KB)

打印邊框規則.rar (76.94 KB)

TOP

回復 4# mark15jill


    謝謝大大提醒。:lol

TOP

回復 5# 198188

先看看執行後是否為需求的列印分頁,再看看後續如何解
20240219_4.zip (177.64 KB)
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

回復 7# Andy2483


    附上“VBA打印格式”,這是根據您的VBA 做出來的效果,另一個附件“正確格式”是我想要的效果。
根據效果,好像雙數的只能顯示一行。

VBA 打印格式.rar (526.5 KB)

正確的格式.rar (486.09 KB)

TOP

本帖最後由 Andy2483 於 2024-2-19 15:27 編輯

回復 8# 198188


    這樣回復無法確認分頁是否正確,如果再調整過欄寬或比例就得重算參數
以下附件是7#檔案匯出PDF檔的結果,與8#回復雞同鴨講
20240219_4.zip (186.6 KB)

以下是後學分頁預覽的狀況:
20240219_1.jpg
2024-2-19 15:22
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

回復 9# Andy2483

我打印PDF 總是把最後一行推到第二頁,這個可能是大家打印的邊界不一樣吧。


另外在相同的SR堶 和 在打印時同一頁,
欄 C 及欄E 如果相同,只要第一行有文字,
欄 C 第一行有框綫,之後的所有相同的,只要四邊有框綫
欄 E 所有相同的,只要四邊有框綫
欄H,I,J,K,L,M,N 四邊有框綫
(之前好像可以,現在變成沒有這個功能了)

TOP

        靜思自在 : 吃苦了苦、苦盡廿來,享福了福、福盡悲來。
返回列表 上一主題