Board logo

標題: [發問] 再次請益收費單的延伸問題 [打印本頁]
作者: dou10801    時間: 2024-3-15 16:01     標題: 再次請益收費單的延伸問題

收費單除了套用[模板套表],但因,(書藉費)跟(輔導費)每個都不一樣,如何用[學生名冊]的D,E欄.套入[模板套表]中,感恩.
作者: hcm19522    時間: 2024-3-17 13:18

本帖最後由 hcm19522 於 2024-3-17 13:37 編輯

G7 (複製到各處)=VLOOKUP($P3,學生名冊!$C:$E,2+(COLUMN(A1)>1),)

(搜尋輸入編號12534) google網址:https://hcm19522.blogspot.com/
作者: Andy2483    時間: 2024-3-18 15:03

回復 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
作者: dou10801    時間: 2024-3-18 15:48

回復 3# Andy2483
可否加註解,讓晚輩學習,感激不盡,謝謝.
作者: Andy2483    時間: 2024-3-19 07:27

回復 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
作者: 准提部林    時間: 2024-3-24 11:58

回復 3# Andy2483

  .Names.Add Name:="PrintArea", RefersTo:=Range(.[A1], xR(0, 28))
>>> Range(.[A1], xR(0, 28)).name = "'" & .Name & "'!Print_Area" .... 直接定義名稱為〔列印範圍〕，且定義名稱最好冠上工作表名稱
>>> .PageSetup.PrintArea = "PrintArea"  .... 有了上一行, 這行可省略, PageSetup會拖慢速度, 非必要少用
作者: Andy2483    時間: 2024-3-25 07:38

回復 6# 准提部林


    謝謝前輩指導
作者: dou10801    時間: 2024-3-25 08:41

請教兩位先進:
[原來]:.Names.Add Name:="PrintArea", RefersTo:=Range(.[A1], xR(0, 28))
[准大]:.Names.Add Name:="PrintArea", RefersTo:=Range(.[A1], xR(0, 28)).Name = "'" & .Name & "'!Print_Area"
執行後出現:應用程式或物件定義錯誤.
感謝謝指導.
作者: Andy2483    時間: 2024-3-25 11:54

回復 8# dou10801

謝謝前輩回復
後學將原方案修成 准大方案後 執行沒有問題
如果前輩有用 Application.ScreenUpdating = False,把它刪掉,再測試看看
作者: dou10801    時間: 2024-3-25 12:18

回復 9# Andy2483
學習中,那邊錯了,請指正,感恩.
作者: Andy2483    時間: 2024-3-25 12:56

回復 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"  ' .... 直接定義名稱為〔列印範圍〕，且定義名稱最好冠上工作表名稱
作者: dou10801    時間: 2024-3-26 08:33

回復 11# Andy2483
執行正常,剛學習,還有很多細節要作功課,感謝多次相助.
還有准大,感恩.



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)