求一個可以快速解決的方法

想將檔案BOOK1中的總表整理成BOOK2的行事
1.可以一班級分類，標題部變
2.每班人數不一樣多
3.名稱為班級+科目
請大大提供可以快速解決的方法，感謝您

Desktop.rar (26.53 KB)

樓主熱帖

opman

中學生 Rank: 2

帖子: 12
主題: 4
精華: 0
積分: 57
點名: 0
作業系統: W7
軟體版本: EX2010
閱讀權限: 20
性別: 男
來自: 台南市
註冊時間: 2014-11-6
最後登錄: 2018-8-30

2^#

發表於 2014-11-7 14:50 | 只看該作者

回復 2# mmxxxx

大大的心收到了，煩請解答的大大可以給程式，小學生無法下載。

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 254
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-23

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

3^#

發表於 2014-11-7 15:39 | 只看該作者

回復 1# opman
直接在BOOK1的工作表模組執行
將會產生新工作表於BOOK1

Sub ex()
Set d = CreateObject("Scripting.Dictionary")
Dim Ar()
With 工作表1
For Each a In .Range(.[A2], .[A2].End(xlDown))
sh = Int(a / 100) & "年" & a Mod 100 & "班" & a.Offset(, 5) '班級科目字串
If IsEmpty(d(sh)) Then
ReDim Ar(1)
Ar(0) = .[A1:O1].Value '標題列
Ar(1) = Application.Transpose(Application.Transpose(a.Resize(, 15).Value)) '第一個資料列
d(sh) = Ar
Else
Ar = d(sh) '讀出陣列
s = UBound(Ar) + 1
ReDim Preserve Ar(s)
Ar(s) = Application.Transpose(Application.Transpose(a.Resize(, 15).Value)) '加入資料列
d(sh) = Ar '寫回陣列
End If
Next
End With
For Each ky In d.keys
With Worksheets.Add(after:=Sheets(Sheets.Count)) '插入工作表
.Name = ky '工作表命名
.Cells.NumberFormat = "@" '設成文字格式
.[A1].Resize(UBound(d(ky)) + 1, 15) = Application.Transpose(Application.Transpose(d(ky))) '寫入資料
End With
Next
End Sub