- 帖子
- 1446
- 主題
- 40
- 精華
- 0
- 積分
- 1470
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-10-21
|
5#
發表於 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
| 