Andy2483

回復 1# dou10801

謝謝前輩發表此主題與範例
後學藉此帖練習陣列與字典,學習方案如下,請前輩參考

Option Explicit
Sub TEST()
Application.DisplayAlerts = False
Dim Brr, i&, xR As Range, Z, T$, j%, Find As Range
Set Z = CreateObject("Scripting.Dictionary")
Brr = Range([學生名冊!F1], [學生名冊!A65536].End(3))
For j = 4 To 6
   T = Trim(Brr(1, j))
   If T = "" Then GoTo j01
   Set Find = [模版套表!B5:X7].Find(T, Lookat:=xlWhole)
   If Find Is Nothing Then MsgBox "找不到 " & T & " 項目": Exit Sub
   Z(Find.Value) = j: Set Z(Find & "/ad") = Find(, 6).Resize(, 2)
j01: Next
With Sheets("結果")
   .Activate: .UsedRange.EntireRow.Delete: Set xR = .[A1]
   For i = 2 To UBound(Brr)
      [模版套表!D3] = Brr(i, 1): [模版套表!K3] = Brr(i, 2): [模版套表!P3] = Brr(i, 3)
      For j = 1 To Z.Count - 1 Step 2: Z.Items()(j).Value = Brr(i, Z.Items()(j - 1)): Next
      [模版套表!1:15].Copy xR: Set xR = xR(16)
      [模版套表!1:15].Copy xR: xR(5, 28) = "第二聯自留": Set xR = xR(16)
      [模版套表!1:14].Copy xR: xR(5, 28) = "第三聯收據": Set xR = xR(15)
      xR.PageBreak = xlPageBreakManual
   Next
   .UsedRange.Interior.ColorIndex = xlNone
   .Names.Add Name:="PrintArea", RefersTo:=Range(.[A1], xR(0, 28))
   .PageSetup.PrintArea = "PrintArea"
   MsgBox "執行完成"
End With
End Sub

Andy2483

回復 4# dou10801

謝謝論壇,謝謝前輩一起學習
後學藉此帖複習修訂,方案心得如下,請前輩參考

Option Explicit
Sub TEST()
Application.DisplayAlerts = False
Dim Brr, i&, xR As Range, Z, T$, j%, Find As Range
'↑宣告變數:&是長整數,$是字串變數,%是短整數,沒有指定的是通用型變數
Set Z = CreateObject("Scripting.Dictionary")
'↑令Z變數是 字典
Brr = Range([學生名冊!F1], [學生名冊!A65536].End(3))
'↑令Brr變數是 以工作表儲存格值帶入的二維陣列
For j = 4 To 6
'↑設順迴圈j從4 到6
   T = Trim(Brr(1, j))
   '↑令T變數是1列j迴圈欄Brr陣列值
   If T = "" Then GoTo j01
   '↑如果T變數是空字元就跳到標示 j01位置繼續執行
   Set Find = [模版套表!B5:X7].Find(T, Lookat:=xlWhole)
   '↑令以T變數搜尋範圍儲存格值全同的儲存格
   If Find Is Nothing Then MsgBox "找不到 " & T & " 項目": Exit Sub
   '↑如果找不到!就跳出提示,結束程式執行
   Z(T) = j: Set Z(Find & "/ad") = Find(, 6).Resize(, 2)
   '↑令Z字典記錄"學生名冊"表欄號,令以Z字典記錄"模版套表"表儲存格
j01: Next
With Sheets("結果")
   .Activate: .UsedRange.EntireRow.Delete: Set xR = .[A1]
   '↑令激活結果表,令舊資料整列刪除,令xR變數是(物件)儲存格[A1]
   For i = 2 To UBound(Brr)
   '↑設順迴圈從2到 Brr陣列縱向最大索引列號
      [模版套表!D3] = Brr(i, 1): [模版套表!K3] = Brr(i, 2): [模版套表!P3] = Brr(i, 3)
      '↑令迴圈列班級/座號/姓名 各欄帶入結果表
      For j = 1 To Z.Count - 1 Step 2: Z.Items()(j).Value = Brr(i, Z.Items()(j - 1)): Next
      '↑設順迴圈將 書籍費/輔導費/其他 各欄帶入結果表
      [模版套表!1:15].Copy xR: Set xR = xR(16)
      [模版套表!1:15].Copy xR: xR(5, 28) = "第二聯自留": Set xR = xR(16)
      [模版套表!1:14].Copy xR: xR(5, 28) = "第三聯收據": Set xR = xR(15)
      '↑令複製 "模版套表"表資料列到結果表指定儲存格
      xR.PageBreak = xlPageBreakManual
      '↑令設定 手動分頁
   Next
   .UsedRange.Interior.ColorIndex = xlNone
   '↑令結果表儲存格底色為無色
   .Names.Add Name:="PrintArea", RefersTo:=Range(.[A1], xR(0, 28))
   '↑令添加 名稱,設定儲存格範圍
   .PageSetup.PrintArea = "PrintArea"
   '↑設定列印範圍
   MsgBox "執行完成"
End With
End Sub

Andy2483

回復 6# 准提部林


    謝謝前輩指導

Andy2483

回復 8# dou10801

謝謝前輩回復
後學將原方案修成 准大方案後 執行沒有問題
如果前輩有用 Application.ScreenUpdating = False,把它刪掉,再測試看看

Andy2483

回復 10# dou10801

.Names.Add Name:="PrintArea", RefersTo:=Range(.[A1], xR(0, 28)).Name = "'" & .Name & "'!Print_Area"
改成
Range(.[A1], xR(0, 28)).name = "'" & .Name & "'!Print_Area"  ' .... 直接定義名稱為〔列印範圍〕，且定義名稱最好冠上工作表名稱