標題: 求一個可以快速解決的方法 [打印本頁]

---

作者: opman    時間: 2014-11-7 14:36     標題: 求一個可以快速解決的方法

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

---

作者: opman    時間: 2014-11-7 14:50

回復 2# mmxxxx


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

---

作者: Hsieh    時間: 2014-11-7 15:39

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

1. Sub ex()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. Dim Ar()
   
4. With 工作表1
   
5.    For Each a In .Range(.[A2], .[A2].End(xlDown))
   
6.       sh = Int(a / 100) & "年" & a Mod 100 & "班" & a.Offset(, 5) '班級科目字串
   
7.       If IsEmpty(d(sh)) Then
   
8.          ReDim Ar(1)
   
9.          Ar(0) = .[A1:O1].Value '標題列
   
10.          Ar(1) = Application.Transpose(Application.Transpose(a.Resize(, 15).Value)) '第一個資料列
    
11.          d(sh) = Ar
    
12.          Else
    
13.          Ar = d(sh) '讀出陣列
    
14.          s = UBound(Ar) + 1
    
15.          ReDim Preserve Ar(s)
    
16.          Ar(s) = Application.Transpose(Application.Transpose(a.Resize(, 15).Value)) '加入資料列
    
17.          d(sh) = Ar '寫回陣列
    
18.        End If
    
19.    Next
    
20. End With
    
21. For Each ky In d.keys
    
22. With Worksheets.Add(after:=Sheets(Sheets.Count)) '插入工作表
    
23.    .Name = ky '工作表命名
    
24.    .Cells.NumberFormat = "@" '設成文字格式
    
25.    .[A1].Resize(UBound(d(ky)) + 1, 15) = Application.Transpose(Application.Transpose(d(ky))) '寫入資料
    
26. End With
    
27. Next
    
28. End Sub

複製代碼

---

作者: opman    時間: 2014-11-7 16:05

回復 4# Hsieh

剛剛試用一下 結果For Each a In .Range(.[A2], .[A2].End(xlDown))就偵測出錯誤
由於剛學可以詳解每段的意思嗎  感恩

---

作者: opman    時間: 2014-11-7 16:12

回復 4# Hsieh


  不好意思，剛修改With 工作表1 改成With Sheet1 就可以使用
真是厲害了
等詳解在好好研究一下 偷師學藝  感謝大大

---

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