samwang

回復 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

ML089

回復 6# q1a2z5


先選擇 B5：G5
輸入公式 =TRANSPOSE(OFFSET(輸入表!$A$1,MATCH(MAX(--(0&MID(A2:A4,4,3))),輸入表!A:A,)-1+(B4="7月")*6,MATCH(--RIGHT(CELL("filename"),3),輸入表!$2:$2,)-1,6))
以陣列公式輸入 (CTRL+SHIFT 先按不放，再按ENTER)三鍵輸入公式

先選擇 B5：G5 複製
先選擇 B7：G7 貼上
先選擇 B9：G9 貼上
先選擇 B11：G11 貼上


複製 Sheet "101" 至 Sheet "102"
複製 Sheet "101" 至 Sheet "103"