擷取報表中所需資料 - Excel程式區

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

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

2^#

發表於 2010-12-30 13:16 | 顯示全部帖子

回復 10# asus103
程式提取的學號已經是數字了

Sub Ex()
Dim A As Range, Ar(), C, d As Object, d1 As Object, d2 As Object, r&, MyClass$, Ky, s%, i%
Set d = CreateObject("Scripting.Dictionary")
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1")
For Each A In .Range(.[B1], .Cells(.Cells.Rows.Count, 2).End(xlUp))
If A Like "*班" Then MyClass = A.Value
If Replace(A.Value, "　", "") = "學號" Then Ar = .Range(A, A.End(xlToRight)).Value
If Val(A.Value) <> 0 And InStr(A, "-") = 0 Then
s = 0
For Each C In Ar
If C <> "" Then d1(C) = ""
If C = "姓名" Then d1("班級") = "": d(A & "班級") = MyClass
d2(A.Value) = ""
d(A & C) = A.Offset(, s).Value
s = s + 1
Next
End If
Next
End With
With Sheets("Sheet4")
.Cells = ""
r = 2
.[A1].Resize(, d1.Count) = d1.KEYS
For Each Ky In d2.KEYS
For i = 1 To d1.Count
.Cells(r, i) = IIf(d(Ky & .Cells(1, i)) = "", -1, d(Ky & .Cells(1, i)))
Next
r = r + 1
Next
End With
End Sub

複製代碼

學海無涯_不恥下問

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

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

3^#

發表於 2010-12-30 15:34 | 顯示全部帖子

回復 12# asus103

Sub Ex()
Dim A As Range, Ar(), C, d As Object, d1 As Object, d2 As Object, r&, MyClass$, Ky, s%, i%
Set d = CreateObject("Scripting.Dictionary")
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1")
For Each A In .Range(.[B1], .Cells(.Cells.Rows.Count, 2).End(xlUp))
If A Like "*班" Then MyClass = A.Value
If Replace(A.Value, "　", "") = "學號" Then Ar = .Range(A, A.End(xlToRight)).Value
If Val(A.Value) <> 0 And InStr(A, "-") = 0 Then
s = 0
For Each C In Ar
If C <> "" Then d1(C) = ""
If C = "姓名" Then d1("班級") = "": d(A & "班級") = Replace(Replace(Replace(Replace(Replace(Replace(MyClass, "高", ""), "年", ""), "班", ""), "三", 3), "二", 2), "一", 1)
d2(A.Value) = ""
d(A & C) = IIf(s > 5, "", "'") & A.Offset(, s).Text
s = s + 1
Next
End If
Next
End With
With Sheets("Sheet4")
.Cells = ""
r = 2
.[A1].Resize(, d1.Count) = d1.KEYS
For Each Ky In d2.KEYS
For i = 1 To d1.Count
.Cells(r, i) = IIf(d(Ky & .Cells(1, i)) = "", -1, d(Ky & .Cells(1, i)))
Next
r = r + 1
Next
End With
End Sub

複製代碼

學海無涯_不恥下問

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

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

4^#

發表於 2010-12-30 16:21 | 顯示全部帖子

改這行
d(A & C) = IIf(s > 2, "", "'") & A.Offset(, s).Text

學海無涯_不恥下問

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

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

5^#

發表於 2011-1-3 12:17 | 顯示全部帖子

回復 17# asus103

http://forum.twbts.com/thread-20-1-1.html
先對該物件的屬性理解後再繼續討論

學海無涯_不恥下問

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

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

6^#

發表於 2011-1-3 14:44 | 顯示全部帖子

回復 19# asus103

dictionary物件觀念可用容器來做比喻
這個容器他是隨著資料多寡而跟著產生儲位的
這個儲位可以由使用者自行編號來表示
這個編號就是引數中的(index)key，關鍵字
至於這個儲位要放置的東西就是(content)item，內容
參考VBA說明
Dictionary 物件

描述

物件，用於儲存資料關鍵字和項目對。

語法

Scripting.Dictionary

請注意

Dictionary 可以是任何型式的資料的項目被儲存在陣列中。每個項目都與一個唯一的關鍵字相關。該關鍵字用來取出單個項目，通常是整數或字串，可以是除陣列外的任何型態。
由以上說明可知，
Dictionary 就是一個容器物件。
再看他有哪些方法?
add 加入項目
exists 檢查項目是否存在
items 傳回所有項目陣列
keys 傳回所有項目之關鍵字陣列
remove 移除項目
removeall 移除所有項目

VBA說明中對ADD方法有提到
Add 方法 (目錄)

描述

加入一對相對應的關鍵字和項目到 Dictionary 物件。

語法

object.Add key, item

Add方法的語法有如下幾個單元：

單元描述
Object 必要引數。一個 Dictionary 物件的名字。
Key 必要引數。與所加入的項目相關的關鍵字。
Item 必要引數。與所加入的關鍵字相關的項目。

請注意

如果該關鍵字已經存在，則產生一個錯誤。
所以，當使用ADD方法時若未先對關鍵字是否存在做檢查，若遇到已重複時就會產生錯誤。
所以我使用d(key)=item這樣的語法可避免這樣的麻煩。
所以當資料中，同樣關鍵字所參照到的內容若不相同時，此關鍵字儲位的內容將會被最後指定的值取代。
所以，dictionary物件的count屬性最簡單的說法就是，dictionary物件的關鍵字數量。

請注意該連結文章中語法的說明
dictionary_object.Add index, content
index就是索引值key
content就是內容item
d1(C) = ""這就是指定關鍵字C的那個儲位留空保存
所以你的解釋沒錯，若c不存在d1.COUNT就會加1

學海無涯_不恥下問