- 帖子
- 976
- 主題
- 7
- 精華
- 0
- 積分
- 1018
- 點名
- 0
- 作業系統
- Win10
- 軟體版本
- Office 2016
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2013-4-19
- 最後登錄
- 2025-8-22
|
回復 9# q1a2z5
我已加上註解，或許您可以從裡面學到一些自己想要的，然後自己修改練習應用，
我也在學習中，論壇有很多厲害前輩，可以多看看觀摩他們的寫法和思考邏輯，
自己多多練習就會有所成長，互相勉勵之，感謝。
Sub tt()
Dim Arr, Ar(1 To 1, 1 To 6), Ar2(1 To 1, 1 To 6), Ar3(1 To 1, 1 To 6)
Dim Ar4(1 To 1, 1 To 6), T$, j&, i&, N%
Application.ScreenUpdating = False
Tm = Timer
Arr = Sheets("輸入表").Range("a1:bb" & [輸入表!B65536].End(3).Row) '資料裝入數組
For j = 3 To UBound(Arr, 2) '從第3欄開始到最後
T = Arr(2, j) '年度
If T = "" Then GoTo 99 '如果年度空白就換下個
For i = 3 To 8: N = N + 1: Ar(1, N) = Arr(i, j): Next: N = 0 '109年1-6月資料裝入Ar數組
For i = 9 To 14: N = N + 1: Ar2(1, N) = Arr(i, j): Next: N = 0 '109年7-12月資料裝入Ar2數組
For i = 17 To 22: N = N + 1: Ar3(1, N) = Arr(i, j): Next: N = 0 '110年1-6月資料裝入Ar3數組
For i = 23 To 28: N = N + 1: Ar4(1, N) = Arr(i, j): Next: N = 0 '110年7-12月資料裝入Ar4數組
With Sheets(T) '每個年度sheet
.Range("B5").Resize(1, 6) = Ar 'Ar資料貼至B5
.Range("B7").Resize(1, 6) = Ar2 'Ar2資料貼至B7
.Range("B9").Resize(1, 6) = Ar3 'Ar3資料貼至B9
.Range("B11").Resize(1, 6) = Ar4 'Ar4資料貼至B11
End With
99: Next
Application.ScreenUpdating = True
MsgBox "執行完成" & Timer - Tm & " 秒"
End Sub |
|
發表於 2021-4-28 10:25
| 
發表於 2021-4-29 13:38
| 