M 19.65 W 藍(lán)橋玄霜 2010-10-18 12:46

本帖最后由 moon2778 于 2013-10-14 16:31 編輯

前言
凡是上過(guò)學(xué)校的人都使用過(guò)字典，從新華字典、成語(yǔ)詞典，到英漢字典以及各種各樣數(shù)不勝數(shù)的專業(yè)字典，字典是上學(xué)必備的、經(jīng)常查閱的工具書(shū)。有了它們，我們可以很方便的通過(guò)查找某個(gè)關(guān)鍵字，進(jìn)而查到這個(gè)關(guān)鍵字的種種解釋，非常快捷實(shí)用。
凡是上過(guò)EH論壇的想學(xué)習(xí)VBA里面字典用法的，幾乎都看過(guò)研究過(guò)northwolves狼版主、oobird版主的有關(guān)字典的精華貼和經(jīng)典代碼。我也是從這里接觸到和學(xué)習(xí)到字典的，在此，對(duì)他們表示深深的謝意，同時(shí)也對(duì)很多把字典用得出神入化的高手們致敬，從他們那里我們也學(xué)到了很多，也得到了提高。
字典對(duì)象只有4個(gè)屬性和6個(gè)方法，相對(duì)其它的對(duì)象要簡(jiǎn)潔得多，而且容易理解使用方便，功能強(qiáng)大，運(yùn)行速度非?？?，效率極高。深受大家的喜愛(ài)。
本文希望通過(guò)對(duì)一些字典應(yīng)用的典型實(shí)例的代碼的詳細(xì)解釋來(lái)給初次接觸字典和想要進(jìn)一步了解字典用法的朋友提供一點(diǎn)備查的參考資料，希望大家能喜歡。
給代碼注釋估計(jì)是大家都怕做的，因?yàn)橥浅隽Σ挥懞玫?，稍不留神或者自己確實(shí)理解得不對(duì)，還會(huì)貽誤他人。所以下面的這些注釋如果有不對(duì)或者不妥當(dāng)?shù)牡胤剑?qǐng)大家跟帖時(shí)指正批評(píng)，及時(shí)改正。

字典的簡(jiǎn)介
字典（Dictionary）對(duì)象是微軟Windows腳本語(yǔ)言中的一個(gè)很有用的對(duì)象。
附帶提一下，有名的正則表達(dá)式（RegExp）對(duì)象和能方便處理驅(qū)動(dòng)器、文件夾和文件的（FileSystemObject ）對(duì)象也是微軟Windows腳本語(yǔ)言中的一份子。
字典對(duì)象相當(dāng)于一種聯(lián)合數(shù)組，它是由具有唯一性的關(guān)鍵字（Key）和它的項(xiàng)（Item）聯(lián)合組成。就好像一本字典書(shū)一樣，是由很多生字和對(duì)它們對(duì)應(yīng)的注解所組成。比如字典的“典”字的解釋是這樣的：
“典”字就是具有唯一性的關(guān)鍵字，后面的解釋就是它的項(xiàng)，和“典”字聯(lián)合組成一對(duì)數(shù)據(jù)。

常用關(guān)鍵字英漢對(duì)照：
Dictionary                字典
Key                        關(guān)鍵字
Item                        項(xiàng)，或者譯為 條目


字典對(duì)象的方法有6個(gè)：Add方法、Keys方法、Items方法、Exists方法、Remove方法、RemoveAll方法。
Add方法
向 Dictionary 對(duì)象中添加一個(gè)關(guān)鍵字項(xiàng)目對(duì)。
object.Add (key, item)
參數(shù)
object
必選項(xiàng)?？偸且粋€(gè) Dictionary 對(duì)象的名稱。
key
必選項(xiàng)。與被添加的 item 相關(guān)聯(lián)的 key。
item
必選項(xiàng)。與被添加的 key 相關(guān)聯(lián)的 item。
說(shuō)明
如果 key 已經(jīng)存在，那么將導(dǎo)致一個(gè)錯(cuò)誤。

常用語(yǔ)句：
Dim d   
Set d = CreateObject('Scripting.Dictionary')
d.Add 'a', 'Athens'   
d.Add 'b', 'Belgrade'
d.Add 'c', 'Cairo'
代碼詳解
1、Dim d ：創(chuàng)建變量，也稱為聲明變量。變量d聲明為可變型數(shù)據(jù)類型(Variant)，d后面沒(méi)有寫(xiě)數(shù)據(jù)類型，默認(rèn)就是可變型數(shù)據(jù)類型(Variant)。也有寫(xiě)成Dim d As Object的，聲明為對(duì)象。
2、Set d = CreateObject('Scripting.Dictionary')：創(chuàng)建字典對(duì)象，并把字典對(duì)象賦給變量d。這是最常用的一句代碼。所謂的“后期綁定”。用了這句代碼就不用先引用c:\windows\system32\scrrun.dll了。
3、d.Add 'a', 'Athens'：添加一關(guān)鍵字”a”和對(duì)應(yīng)于它的項(xiàng)”Athens”。
4、d.Add 'b', “Belgrade”：添加一關(guān)鍵字”b”和對(duì)應(yīng)于它的項(xiàng)”Belgrade”。
5、d.Add 'c', “Cairo”：添加一關(guān)鍵字”c”和對(duì)應(yīng)于它的項(xiàng)”Cairo”。

Exists方法
如果 Dictionary 對(duì)象中存在所指定的關(guān)鍵字則返回 true，否則返回 false。
object.Exists(key)
參數(shù)
object
必選項(xiàng)?？偸且粋€(gè) Dictionary 對(duì)象的名稱。
key
必選項(xiàng)。需要在 Dictionary 對(duì)象中搜索的 key 值。

常用語(yǔ)句：
Dim d, msg$   
   Set d = CreateObject('Scripting.Dictionary')
   d.Add 'a', 'Athens'   
   d.Add 'b', 'Belgrade'
   d.Add 'c', 'Cairo'
   If d.Exists('c') Then
      msg = '指定的關(guān)鍵字已經(jīng)存在。'
   Else
      msg = '指定的關(guān)鍵字不存在。'
   End If
代碼詳解
1、Dim d, msg$ ：聲明變量，d見(jiàn)前例；msg$ 聲明為字符串?dāng)?shù)據(jù)類型(String)，一般寫(xiě)法為Dim msg As String。String 的類型聲明字符為美元號(hào) ($)。
2、If d.Exists('c') Then：如果字典中存在關(guān)鍵字”c”，那么執(zhí)行下面的語(yǔ)句。
3、msg = '指定的關(guān)鍵字已經(jīng)存在。' ：把'指定的關(guān)鍵字已經(jīng)存在。'字符串賦給變量msg。
4、Else ：否則執(zhí)行下面的語(yǔ)句。
5、msg = '指定的關(guān)鍵字不存在。' ：把'指定的關(guān)鍵字不存在。'字符串賦給變量msg。
6、End If ：結(jié)束If …Else…Endif判斷。

Keys方法
返回一個(gè)數(shù)組，其中包含了一個(gè) Dictionary 對(duì)象中的全部現(xiàn)有的關(guān)鍵字。
object.Keys( )
其中 object 總是一個(gè) Dictionary 對(duì)象的名稱。

常用語(yǔ)句：
Dim d, k   
   Set d = CreateObject('Scripting.Dictionary')
   d.Add 'a', 'Athens'   
   d.Add 'b', 'Belgrade'
   d.Add 'c', 'Cairo'
   k=d.Keys
   [B1].Resize(d.Count,1)=Application.Transpose(k)
代碼詳解
1、Dim d, k ：聲明變量，d見(jiàn)前例；k默認(rèn)是可變型數(shù)據(jù)類型(Variant)。
2、k=d.Keys：把字典中存在的所有的關(guān)鍵字賦給變量k。得到的是一個(gè)一維數(shù)組，下限為0，上限為d.Count-1。這是數(shù)組的默認(rèn)形式。
3、[B1].Resize(d.Count,1)=Application.Transpose(k) ：這句代碼是很常用很經(jīng)典的代碼，所以這里要多說(shuō)一些。
Resize是Range對(duì)象的一個(gè)屬性，用于調(diào)整指定區(qū)域的大小，它有兩個(gè)參數(shù)，第一個(gè)是行數(shù)，本例是d.Count，指的是字典中關(guān)鍵字的數(shù)量，整本字典中有多少個(gè)關(guān)鍵字，本例d.Count=3，因?yàn)橛?個(gè)關(guān)鍵字。呵呵，是不是說(shuō)多了。
第二個(gè)是列數(shù)，本例是1。這樣＝左邊的意思就是：把一個(gè)單元格B1調(diào)整為以B1開(kāi)始的一列單元格區(qū)域，行數(shù)等于字典中關(guān)鍵字的數(shù)量d.Count，就是把單元格B1調(diào)整為單元格區(qū)域B1：B3了。
＝右邊的k是個(gè)一維數(shù)組，是水平排列的，我們知道Excel工作表函數(shù)里面有個(gè)轉(zhuǎn)置函數(shù)Transpose，用它可以把水平排列的置換成豎向排列。但是在VBA中不能直接使用該工作表函數(shù)，需要通過(guò)Application對(duì)象的WorksheetFunction屬性來(lái)使用它。所以完整的寫(xiě)法是Application. WorksheetFunction.Transpose(k)，中間的WorksheetFunction可省略?，F(xiàn)在可以解釋這句代碼了：把字典中所有的關(guān)鍵字賦給以B1單元格開(kāi)始的單元格區(qū)域中。
Items方法
返回一個(gè)數(shù)組，其中包含了一個(gè) Dictionary 對(duì)象中的所有項(xiàng)目。
object.Items( )
其中 object 總是一個(gè) Dictionary 對(duì)象的名稱。

常用語(yǔ)句：
Dim d, t   
   Set d = CreateObject('Scripting.Dictionary')
   d.Add 'a', 'Athens'   
   d.Add 'b', 'Belgrade'
   d.Add 'c', 'Cairo'
   t=d.Items
   [C1].Resize(d.Count,1)=Application.Transpose(t)
代碼詳解
1、Dim d, t ：聲明變量，d見(jiàn)前例；t默認(rèn)是可變型數(shù)據(jù)類型(Variant)。
2、t=d.Items ：把字典中所有的關(guān)鍵字對(duì)應(yīng)的項(xiàng)賦給變量t。得到的也是一個(gè)一維數(shù)組，下限為0，上限為d.Count-1。這是數(shù)組的默認(rèn)形式。
3、[C1].Resize(d.Count,1)=Application.Transpose(t) ：有了上面Keys方法的解釋這句代碼就不用多說(shuō)了，就是把字典中所有的關(guān)鍵字對(duì)應(yīng)的項(xiàng)賦給以C1單元格開(kāi)始的單元格區(qū)域中。

Remove方法
Remove 方法從一個(gè) Dictionary 對(duì)象中清除一個(gè)關(guān)鍵字，項(xiàng)目對(duì)。
object.Remove(key )
其中 object 總是一個(gè) Dictionary 對(duì)象的名稱。
key
必選項(xiàng)。key 與要從 Dictionary 對(duì)象中刪除的關(guān)鍵字，項(xiàng)目對(duì)相關(guān)聯(lián)。
說(shuō)明
如果所指定的關(guān)鍵字，項(xiàng)目對(duì)不存在，那么將導(dǎo)致一個(gè)錯(cuò)誤。

常用語(yǔ)句：
Dim d   
   Set d = CreateObject('Scripting.Dictionary')
   d.Add 'a', 'Athens'   
   d.Add 'b', 'Belgrade'
   d.Add 'c', 'Cairo'
   ……
   d.Remove(“b”)
代碼詳解
1、d.Remove(“b”)：清除字典中”b”關(guān)鍵字和與它對(duì)應(yīng)的項(xiàng)。清除之后,現(xiàn)在字典里只有2個(gè)關(guān)鍵字了。

RemoveAll方法
RemoveAll 方法從一個(gè) Dictionary 對(duì)象中清除所有的關(guān)鍵字，項(xiàng)目對(duì)。
object.RemoveAll( )
其中 object 總是一個(gè) Dictionary 對(duì)象的名稱。
常用語(yǔ)句：
Dim d   
   Set d = CreateObject('Scripting.Dictionary')
   d.Add 'a', 'Athens'   
   d.Add 'b', 'Belgrade'
   d.Add 'c', 'Cairo'
   ……
   d.RemoveAll
代碼詳解
1、d.RemoveAll：清除字典中所有的數(shù)據(jù)。也就是清空這字典，然后可以添加新的關(guān)鍵字和項(xiàng)，形成一本新字典。

字典對(duì)象的屬性有4個(gè)：Count屬性、Key屬性、Item屬性、CompareMode屬性。
Count屬性
返回一個(gè)Dictionary 對(duì)象中的項(xiàng)目數(shù)。只讀屬性。
        object.Count
其中 object一個(gè)字典對(duì)象的名稱。
常用語(yǔ)句：
Dim d,n%   
   Set d = CreateObject('Scripting.Dictionary')
   d.Add 'a', 'Athens'   
   d.Add 'b', 'Belgrade'
   d.Add 'c', 'Cairo'
   n = d.Count
代碼詳解
1、Dim d, n% ：聲明變量，d見(jiàn)前例；n被聲明為整型數(shù)據(jù)類型(Integer)。一般寫(xiě)法為Dim n As Integer 。 Integer 的類型聲明字符為百分比號(hào) (%)。
2、n = d.Count  ：把字典中所有的關(guān)鍵字的數(shù)量賦給變量n。本例得到的是3。


Key屬性
在 Dictionary 對(duì)象中設(shè)置一個(gè) key。
object.Key(key) = newkey
參數(shù)：
object
必選項(xiàng)。總是一個(gè)字典 (Dictionary) 對(duì)象的名稱。
key
必選項(xiàng)。被改變的 key 值。
newkey
必選項(xiàng)。替換所指定的 key 的新值。
說(shuō)明
如果在改變一個(gè) key 時(shí)沒(méi)有發(fā)現(xiàn)該 key，那么將創(chuàng)建一個(gè)新的 key 并且其相關(guān)聯(lián)的 item 被設(shè)置為空。
常用語(yǔ)句：
Dim d   
   Set d = CreateObject('Scripting.Dictionary')
   d.Add 'a', 'Athens'   
   d.Add 'b', 'Belgrade'
   d.Add 'c', 'Cairo'
   d.Key('c') = 'd'
代碼詳解
1、d.Key('c') = 'd' ：用新的關(guān)鍵字”d”來(lái)替換指定的關(guān)鍵字”c”，這時(shí)，字典中就沒(méi)有關(guān)鍵字c了，只有關(guān)鍵字d了，與d對(duì)應(yīng)的項(xiàng)是”Cairo”。

Item屬性
在一個(gè) Dictionary 對(duì)象中設(shè)置或者返回所指定 key 的 item。對(duì)于集合則根據(jù)所指定的 key 返回一個(gè) item。讀/寫(xiě)。
object.Item(key)[ = newitem]
參數(shù)
object
必選項(xiàng)?？偸且粋€(gè)Dictionary 對(duì)象的名稱。
key
必選項(xiàng)。與要被查找或添加的 item 相關(guān)聯(lián)的 key。
newitem
可選項(xiàng)。僅適用于 Dictionary 對(duì)象；newitem 就是與所指定的 key 相關(guān)聯(lián)的新值。
說(shuō)明
如果在改變一個(gè) key 的時(shí)候沒(méi)有找到該 item，那么將利用所指定的 newitem 創(chuàng)建一個(gè)新的 key。如果在試圖返回一個(gè)已有項(xiàng)目的時(shí)候沒(méi)有找到 key，那么將創(chuàng)建一個(gè)新的 key 且其相關(guān)的項(xiàng)目被設(shè)置為空。
常用語(yǔ)句：
Dim d   
   Set d = CreateObject('Scripting.Dictionary')
   d.Add 'a', 'Athens'   
   d.Add 'b', 'Belgrade'
   d.Add 'c', 'Cairo'
   MsgBox  d.Item('c')
代碼詳解
1、d.Item('c') ：獲取指定的關(guān)鍵字”c”對(duì)應(yīng)的項(xiàng)。
2、MsgBox   ：是一個(gè)VBA函數(shù)，用消息框顯示。如果要詳細(xì)了解MsgBox函數(shù)的，可參見(jiàn)我的另一篇文章“常用VBA函數(shù)精選合集”。http://club./thread-387253-1-1.html

CompareMode屬性
設(shè)置或者返回在 Dictionary 對(duì)象中進(jìn)行字符串關(guān)鍵字比較時(shí)所使用的比較模式。
object.CompareMode[ = compare]
參數(shù)
object
必選項(xiàng)?？偸且粋€(gè) Dictionary 對(duì)象的名稱。
compare
可選項(xiàng)。如果提供了此項(xiàng)，compare 就是一個(gè)代表比較模式的值?？梢允褂玫闹凳?0 (二進(jìn)制)、1 (文本), 2 (數(shù)據(jù)庫(kù))。
說(shuō)明
如果試圖改變一個(gè)已經(jīng)包含有數(shù)據(jù)的 Dictionary 對(duì)象的比較模式，那么將導(dǎo)致一個(gè)錯(cuò)誤。
常用語(yǔ)句：
Dim d   
   Set d = CreateObject('Scripting.Dictionary')
   d.CompareMode = vbTextCompare
   d.Add 'a', 'Athens'   
   d.Add 'b', 'Belgrade'
   d.Add 'c', 'Cairo'
   d.Add ' B ', ' Baltimore'
代碼詳解
1、d.CompareMode = vbTextCompare  ：設(shè)置字典的比較模式是文本，在這種比較模式下不區(qū)分關(guān)鍵字的大小寫(xiě)，即關(guān)鍵字”b”和”B”是一樣的。vbTextCompare的值為1，所以上式也可寫(xiě)為 d.CompareMode =1 。如果設(shè)置為vbBinaryCompare（值為0），則執(zhí)行二進(jìn)制比較，即區(qū)分關(guān)鍵字的大小寫(xiě)，此種情況下關(guān)鍵字”b”和”B”被認(rèn)為是不一樣的。
2、d.Add ' B ', ' Baltimore' ：添加一關(guān)鍵字”B”和對(duì)應(yīng)于它的項(xiàng)”Baltimore”。由于前面已經(jīng)設(shè)置了比較模式為文本模式，不區(qū)分關(guān)鍵字的大小寫(xiě)，即關(guān)鍵字”b”和”B”是一樣的，此時(shí)發(fā)生錯(cuò)誤添加失敗，因?yàn)樽值渲幸呀?jīng)存在”b”了，字典中的關(guān)鍵字是唯一的，不能添加重復(fù)的關(guān)鍵字。

[ 本帖最后由 藍(lán)橋玄霜 于 2010-10-24 19:55 編輯 ]
分享到新浪微博

L 2樓 藍(lán)橋玄霜 2010-10-18 12:48

實(shí)例1 普通常見(jiàn)的求不重復(fù)值問(wèn)題 實(shí)例2 求多表的不重復(fù)值問(wèn)題

實(shí)例1  普通常見(jiàn)的求不重復(fù)值問(wèn)題
一、問(wèn)題的提出：
表格中人員有很多是重復(fù)的，要求編寫(xiě)一段代碼，把重復(fù)的人員姓名以及重復(fù)的次數(shù)求出來(lái)，復(fù)制到另一個(gè)表格中。三、代碼詳解
1、Dim i&, Myr&, Arr ：變量i和Myr聲明為長(zhǎng)整型變量。 也可以寫(xiě)為 Dim Myr As Long 。Long 的類型聲明字符為(&)。Arr后面沒(méi)有寫(xiě)明數(shù)據(jù)類型，默認(rèn)就是可變型數(shù)據(jù)類型(Variant)。
2、Set d = CreateObject('Scripting.Dictionary')：創(chuàng)建字典對(duì)象，并把字典對(duì)象賦給變量d。這是最常用的一句代碼。所謂的“后期綁定”。用了這句代碼就不用先引用c:\windows\system32\scrrun.dll了。
3、Myr = Sheet1.[a65536].End(xlUp).Row ：把表1的A列最后一行不為空白的行數(shù)賦給變量Myr。這里用了Range對(duì)象的End屬性，它有4個(gè)方向參數(shù)，此處的xlUp表示向上，它的值為3，所以也可寫(xiě)成End(3)。xlDown表示向下，它的值為4；xlToLeft表示向左，它的值為1；xlToRight表示向右，它的值為2。
4、Arr = Sheet1.Range('a1:g' & Myr)：把表1的A1到G列最后一行不為空白的 單元格區(qū)域的值賦給變量Arr。這樣Arr就是個(gè)二維數(shù)組了，用數(shù)組替代單元格引用可對(duì)執(zhí)行代碼的速度提高很多很多。
5、For i = 2 To UBound(Arr) ：For…Next循環(huán)結(jié)構(gòu)，從2開(kāi)始到數(shù)組的最大上界值之間循環(huán)。因?yàn)閿?shù)組的第一行是表頭。Ubound是VBA函數(shù)，返回?cái)?shù)組的指定維數(shù)的最大可用上界。
6、d(Arr(i, 3)) = d(Arr(i, 3)) + 1 ：Arr(i,3)在本例是姓名列，也就是關(guān)鍵字列，舉個(gè)例子，假如Arr(i,3)=”張三”，這句代碼的意思就是把關(guān)鍵字”張三”加入字典，d(key)等于關(guān)鍵字key對(duì)應(yīng)的項(xiàng)，每出現(xiàn)一次這個(gè)關(guān)鍵字，它的項(xiàng)的值就增加1。起到了按關(guān)鍵字累加的作用，也正因?yàn)橛羞@個(gè)作用，所以可使用字典來(lái)進(jìn)行各種匯總統(tǒng)計(jì)。后面要講的實(shí)例會(huì)充分的展現(xiàn)這個(gè)作用。
7、k=d.keys ：把字典d中存在的所有的關(guān)鍵字賦給變量k。得到的是一個(gè)一維數(shù)組，下限為0，上限為d.Count-1。Keys是字典的方法，前面已經(jīng)講過(guò)了。
8、t=d.items ：把字典d中存在的所有的關(guān)鍵字對(duì)應(yīng)的項(xiàng)賦給變量t。得到的也是一個(gè)一維數(shù)組，下限為0，上限為d.Count-1。Items也是字典的方法，前面也已經(jīng)講過(guò)了。
9、Sheet2.Activate ：激活表2。
10、[a2].Resize(d.Count, 1) = Application.Transpose(k) ：把字典d中所有的關(guān)鍵字賦給以a2單元格開(kāi)始的單元格區(qū)域中。詳細(xì)的解釋請(qǐng)見(jiàn)前面的keys方法一節(jié)。
11、[b2].Resize(d.Count, 1) = Application.Transpose(t) ：把字典d中所有的關(guān)鍵字對(duì)應(yīng)的項(xiàng)賦給以b2單元格開(kāi)始的單元格區(qū)域中。
12、[a1].Resize(1, 2) = Array('姓名', '重復(fù)個(gè)數(shù)') ：Array是一個(gè)VBA函數(shù)，返回一個(gè)下界為0的一維數(shù)組。一維數(shù)組是水平排列的，所以賦值給水平的單元格區(qū)域不需要用轉(zhuǎn)置函數(shù)了。這里作為表頭一次性輸入。
13、Set d = Nothing  ：釋放字典內(nèi)存。

實(shí)例2  求多表的不重復(fù)值問(wèn)題
一、問(wèn)題的提出：
一工作簿里面有3張工作表上，每張表格的A列都是姓名列，所有這些姓名中有些是重復(fù)的，要求編寫(xiě)一段代碼，在另一個(gè)工作表上顯示不重復(fù)的姓名。
如圖實(shí)例2－1所示。

圖  實(shí)例2-1  

這個(gè)問(wèn)題也很適合用字典來(lái)解決。代碼如下：三、代碼詳解
1、For Each Sht In Sheets ：For Each…Next循環(huán)結(jié)構(gòu)，這種形式是VBA特有的，用于對(duì)對(duì)象的循環(huán)非常適用。意思是在所有的工作表中依次循環(huán)。
2、If Sht.Name <> 'Sheet4' Then ：如果這個(gè)工作表的名字不等于”Sheet4”時(shí)執(zhí)行下面的代碼。
3、Myr = Sht.[a65536].End(xlUp).Row ：求得這個(gè)工作表A列有數(shù)據(jù)的最后一行的行數(shù)，把它賦給變量Myr。這里用了長(zhǎng)整型數(shù)據(jù)類型(Long)，數(shù)據(jù)范圍最大可到2,147,483,647，是為了避免數(shù)據(jù)很多的時(shí)候會(huì)超出整型數(shù)據(jù)類型(Integer)而出錯(cuò)，因?yàn)檎蛿?shù)據(jù)類型數(shù)據(jù)范圍最大只到32,767。
4、Arr = Sht.Range('a2:a' & Myr)  ：把A列數(shù)據(jù)賦給數(shù)組Arr。
5、For i = 1 To UBound(Arr) ：For…Next循環(huán)結(jié)構(gòu)，從1開(kāi)始到數(shù)組的最大上限值之間循環(huán)。Ubound是VBA函數(shù)，返回?cái)?shù)組的指定維數(shù)的最大值。
6、d(Arr(i, 1)) = “” ：這句代碼的意思就是把關(guān)鍵字Arr(i,1)加入字典，關(guān)鍵字對(duì)應(yīng)的項(xiàng)為空，相當(dāng)于字典中的這個(gè)關(guān)鍵字沒(méi)有解釋。和d.Add Arr(i,1), ''的效果相同，只是代碼更簡(jiǎn)潔一些。
7、k=d.keys ：把字典d中存在的所有的關(guān)鍵字賦給變量k。得到的是一個(gè)一維數(shù)組，下限為0，上限為d.Count-1。Keys是字典的方法，前面已經(jīng)講過(guò)了。
8、Sheet4.[a3] .Resize(d.Count, 1) = Application.Transpose(k) ：把字典d中所有的關(guān)鍵字賦給表4以a3單元格開(kāi)始的單元格區(qū)域中。

代碼執(zhí)行后如圖實(shí)例2-2所示。

圖  實(shí)例2-2

[ 本帖最后由 藍(lán)橋玄霜 于 2010-10-20 11:11 編輯 ]

L 3樓 藍(lán)橋玄霜 2010-10-18 12:50

實(shí)例3 實(shí)例4

實(shí)例3  A列中顯示1 ~ 1000中被6除余1和余5 的數(shù)字
一、問(wèn)題的提出：
有1、2、3…1000一千個(gè)數(shù)字，要求編寫(xiě)一段代碼，在工作表的A列顯示這些數(shù)被6除余1和余5的數(shù)字。三、代碼詳解
1、Dim dic As Object, i As Long, arr  ：也可把字典變量dic聲明為對(duì)象(Object)，i As Long是規(guī)范的寫(xiě)法，也可寫(xiě)成i& 。
2、dic.Add i & IIf(Abs(i Mod 6 - 3) = 2, '@', ''), '' ：這句代碼的內(nèi)容比較多，用了兩個(gè)VBA函數(shù)IIf和Abs，用了一個(gè)Mod運(yùn)算符。i Mod 6就是每一個(gè)數(shù)除6的余數(shù)，題目中有兩個(gè)要求：余1和與5，為了從1到1000都同時(shí)能滿足這兩個(gè)要求，所以用了Abs(i Mod 6 - 3) = 2 ，Abs是取絕對(duì)值函數(shù)。另一個(gè)VBA函數(shù)IIf是根據(jù)判斷條件返回結(jié)果，和If…Then判斷結(jié)果類似；IIf(Abs(i Mod 6 - 3) = 2, '@', '') 這段的意思是如果符合判斷條件，返回”@”否則返回空””。 i & IIf(Abs(i Mod 6 - 3) = 2, '@', '')的意思是把這個(gè)數(shù)與”@”或者”””連起來(lái)作為關(guān)鍵字加入字典dic，關(guān)鍵字相對(duì)應(yīng)的項(xiàng)為空。比如當(dāng)i=1時(shí)，1是滿足上述表達(dá)式的，就把”1@” 作為關(guān)鍵字加入字典dic；當(dāng)i=2時(shí)，2不滿足上述表達(dá)式，就把”2” 作為關(guān)鍵字加入字典dic，關(guān)鍵字相對(duì)應(yīng)的項(xiàng)都為空。
3、arr = WorksheetFunction.Transpose(Filter(dic.keys, '@')) ：這句代碼的內(nèi)容分為3部分，第1部分是Filter(dic.keys, '@') 其中的Filter是一個(gè)VBA函數(shù)，VBA函數(shù)就是可以直接在代碼中使用的，我們平常使用的函數(shù)叫工作表函數(shù)，如Sum、Sumif、Transpose等等。Filter函數(shù)要求在一維數(shù)組中篩選出符合條件的另一個(gè)一維數(shù)組，式中的dic.keys正是一個(gè)一維數(shù)組。這里的篩選條件是”@”，也就是把字典關(guān)鍵字中含有@的關(guān)鍵字篩選出來(lái)組成一個(gè)新的一維數(shù)組，其下標(biāo)從零開(kāi)始。第2部分是用工作表函數(shù)Transpose轉(zhuǎn)置這個(gè)新的一維數(shù)組，工作表函數(shù)的使用在前面keys方法一節(jié)已經(jīng)說(shuō)過(guò)了；第2部分是把轉(zhuǎn)置以后的值賦給數(shù)組變量Arr。
呵呵，狼版主的代碼是短了，我的解釋卻太長(zhǎng)了。
4、[a1].Resize(UBound(arr), 1) = arr ：把數(shù)組Arr賦給[a1]單元格開(kāi)始的區(qū)域中。
5、[a:a].Replace '@', ''  ：把A列中的所有的@都替換為空白，只剩下數(shù)字了。

實(shí)例4  拆分?jǐn)?shù)據(jù)不重復(fù)
一、問(wèn)題的提出：
有一列各種手機(jī)品牌型號(hào)的數(shù)據(jù)，要求編寫(xiě)一段代碼，按照品牌劃分成沒(méi)有重復(fù)數(shù)據(jù)的三大類。
二、代碼：三、代碼詳解
1、Set d2 = CreateObject('Scripting.Dictionary')  ：針對(duì)三個(gè)不同的種類，創(chuàng)建d、d1、d2三個(gè)字典對(duì)象。
2、Myr = [a65536].End(xlUp).Row  ：把A列最后一行不為空白的行數(shù)賦給變量Myr。
3、Arr = Range('a2:a' & Myr)  ：把A2開(kāi)始的有數(shù)據(jù)的單元格區(qū)域賦給變量Arr。
4、Range('c2:e' & Myr).ClearContents ：把C2到E列單元格區(qū)域清空。
5、my = Array('MOTO', '諾基亞', '三星', '索愛(ài)') ：VBA函數(shù)Array返回一個(gè)一維數(shù)組，默認(rèn)下界為0。把Array函數(shù)返回的數(shù)組賦給變量my(貿(mào)易兩漢字的首字母)。
6、gc = Array('OPPO', '聯(lián)想', '天語(yǔ)', '金立', '步步高', '波導(dǎo)', 'TCL', '酷派') ：把Array函數(shù)返回的數(shù)組賦給變量gc(國(guó)產(chǎn)兩漢字的首字母)。
7、For x = 1 To UBound(Arr) ：在A列原始數(shù)據(jù)的數(shù)組中逐一循環(huán)。
8、For i = 0 To UBound(my) ：在my數(shù)組中逐一循環(huán)。因?yàn)橛?個(gè)貿(mào)易機(jī)品牌，所以用循環(huán)每一個(gè)與原始數(shù)據(jù)比較。
9、If InStr(Arr(x, 1), my(i)) > 0 Then ：VBA函數(shù)Instr返回在第1個(gè)參數(shù)中查找的位置，如果返回結(jié)果＝0，表示在第1個(gè)參數(shù)中沒(méi)有第2個(gè)參數(shù)存在。本句的意思是如果找到貿(mào)易機(jī)品牌的話，執(zhí)行下面的代碼。
10、d1(Arr(x, 1)) = '' ：接上句，如果上面判斷成立，就把Arr(x, 1)加入字典d。
11、GoTo 100 ：Goto語(yǔ)句用于無(wú)條件地轉(zhuǎn)移到過(guò)程中指定的行。這里采用跳出For i循環(huán)，一是為了減少循環(huán)的次數(shù)，比如'MOTO'找到的話，后面3個(gè)就不需要找了；二是為了跳過(guò)兩個(gè)小循環(huán)之后的其它品牌加入第3個(gè)字典的d2(Arr(x, 1)) = ''語(yǔ)句。
12、For j循環(huán)與上面相同，為了判斷得到國(guó)產(chǎn)機(jī)類的字典d1。
13、d2(Arr(x, 1)) = '' ：如果上述兩個(gè)小循環(huán)都不滿足，那么就加入其它品牌類字典里。
14、Range('c2').Resize(UBound(d.keys) + 1, 1) = Application.Transpose(d.keys) ：最后的3句分別把字典的關(guān)鍵字?jǐn)?shù)組轉(zhuǎn)置后賦給相應(yīng)的單元格區(qū)域。

山菊花版主用了一個(gè)字典對(duì)象就解決了上述問(wèn)題。讓我們來(lái)學(xué)習(xí)一下。

四、山菊花版主的代碼：五、代碼詳解
1、pp1 = Join(WorksheetFunction.Transpose(Range(Range('g2'), _
Range('g1').End(xlDown))), ',') ：
這句代碼用了兩個(gè)VBA函數(shù)Join 和Transpose ，Range('g1').End(xlDown)從G1單元格往下直到最下面的單元格，遇到空白格就停止。因?yàn)楸纠腉14、G15單元格有 另外的數(shù)據(jù)存在，如果還是用Range('g65536').End(xlUp)，那么就會(huì)把不需要的數(shù)據(jù)帶進(jìn)去，造成結(jié)果出錯(cuò)。Transpose 轉(zhuǎn)置函數(shù)，前面已經(jīng)介紹過(guò)了。Join函數(shù)是通過(guò)連接某個(gè)數(shù)組中的多個(gè)子字符串而創(chuàng)建的一個(gè)字符串，本句代碼執(zhí)行后得到pp1='MOTO, 諾基亞, 三星, 索愛(ài)'。
pp2一句同上句一樣，得到另一個(gè)字符串。
2、nRow = Range('a1').End(xlDown).Row   ：把A列最后一行不為空白的行數(shù)賦給整型變量nRow。
3、Arr = Range('a1:a' & nRow) ：把A列A1開(kāi)始的有數(shù)據(jù)的單元格區(qū)域賦給變量Arr。
4、ReDim Brr(1 To nRow, 1 To 3) ：用于為動(dòng)態(tài)數(shù)組變量Brr重新分配存儲(chǔ)空間。第一維的下界從1到上界nRow，第二維從1到3。
5、For i = 2 To nRow ：從2到 nRow逐一循環(huán)。
6、If Not ds.Exists(Arr(i, 1)) Then ：如果字典ds中不存在關(guān)鍵字Arr(i, 1)
7、ds(Arr(i, 1)) = '' ：把Arr(i, 1)作為關(guān)鍵字加入字典ds。
8、If pp1 Like '*' & Left(Arr(i, 1), 2) & '*' Then ：這里山版主用了比較運(yùn)算符Like來(lái)比較pp1和取自Arr(i, 1)左邊兩個(gè)字符，再在前后加任意字符組成的字符串，如果滿足條件為真，那么執(zhí)行下面的語(yǔ)句。
9、s(1) = s(1) + 1 ：數(shù)組s的第一個(gè)元素+1以后賦給數(shù)組s的第一個(gè)元素。
10、Brr(s(1), 1) = Arr(i, 1) ：把這個(gè)關(guān)鍵字賦給第2維為1的另一個(gè)數(shù)組Brr，也就是我們要求的貿(mào)易機(jī)類。pp1字符串里都是貿(mào)易機(jī)類的品牌。
11、ElseIf pp2 Like '*' & Left(Arr(i, 1), 2) & '*' Then ：同樣，如果滿足國(guó)產(chǎn)品牌類這個(gè)條件，那么執(zhí)行下面的代碼。
12、s(2) = s(2) + 1 ：數(shù)組s的第二個(gè)元素+1以后賦給數(shù)組s的第二個(gè)元素。
13、Brr(s(2), 2) = Arr(i, 1) ：把這個(gè)關(guān)鍵字賦給第2維為2的另一個(gè)數(shù)組Brr，也就是我們要求的國(guó)產(chǎn)品牌類。pp2字符串里都是國(guó)產(chǎn)品牌類的品牌。
14、s(3) = s(3) + 1 ：前如果條件都不滿足時(shí)，數(shù)組s的第三個(gè)元素+1以后賦給數(shù)組s的第三個(gè)元素。
15、Brr(s(3), 3) = Arr(i, 1) ：把這個(gè)關(guān)鍵字賦給第3維為1的另一個(gè)數(shù)組Brr，也就是我們要求的其它品牌類。
16、Range('c2:e' & nRow) = Brr ：把數(shù)組Brr賦給[c2]單元格開(kāi)始的區(qū)域中。

[ 本帖最后由 藍(lán)橋玄霜 于 2010-10-21 10:24 編輯 ]

L 4樓 藍(lán)橋玄霜 2010-10-18 12:52

實(shí)例5 實(shí)例6

[/code]實(shí)例5  前期綁定的字典實(shí)例
一、問(wèn)題的提出：
有多列多行數(shù)據(jù)，其中有重復(fù)的行，要求編寫(xiě)一段代碼，求得不重復(fù)的行數(shù)據(jù)。
如圖實(shí)例5-1所示。[code]Sub 保留原數(shù)據(jù)()  ‘by:ldy888
‘前期綁定，需先引用c:\windows\system32\scrrun.dll
    Dim d As New Dictionary,t
    For i = 2 To 5
        Set d(Cells(i, 1) & '') = Range(Cells(i, 1), Cells(i, 4))
Next
t=d.items       
[A11].Resize(d.Count, 4) = Application.Transpose(Application.Transpose(t))
End Sub
[/code]三、代碼詳解
1、Dim d As New Dictionary, t  ：本段代碼需要先引用微軟的腳本運(yùn)行時(shí)庫(kù)Microsoft Scripting Runtime，可在VBE窗口，從菜單－工具－引用，然后勾選Microsoft Scripting Runtime，或者點(diǎn)擊瀏覽，在添加引用對(duì)話框中選擇c:\windows\system32\scrrun.dll，并打開(kāi)，確定。完成引用。在本聲明語(yǔ)句中把字典d聲明為New Dictionary。這就是”前期綁定”了。上面的實(shí)例用的是創(chuàng)建對(duì)象語(yǔ)句：
Set d = CreateObject('Scripting.Dictionary')，稱為”后期綁定”。不需要先引用腳本運(yùn)行時(shí)庫(kù)。
2、Set d(Cells(i, 1) & '') = Range(Cells(i, 1), Cells(i, 4)) ：把單元格對(duì)象加入字典，它對(duì)應(yīng)的項(xiàng)是同一行的單元格區(qū)域。注意，這里用了Set，和前面的幾例不一樣哦。如果用Typename(d(Cells(i, 1) & ''))，得到的是一個(gè)Range對(duì)象。這里的Cells(i, 1) & ''也可以用Cells(i, 1).Value來(lái)代替。
3、t=d.items   ：把字典d中存在的所有的關(guān)鍵字對(duì)應(yīng)的項(xiàng)賦給變量t。得到的是一個(gè)一維數(shù)組，下限為0，上限為d.Count-1。
4、[A11].Resize(d.Count, 4) = Application.Transpose(Application.Transpose(t)) ：這句用了兩次工作表轉(zhuǎn)置函數(shù)Transpose之后賦給A11單元格開(kāi)始的區(qū)域中。

代碼執(zhí)行后如圖實(shí)例5-2所示。

實(shí)例6  多條件復(fù)雜匯總
一、問(wèn)題的提出：
有一個(gè)表格，需要對(duì)其中多個(gè)條件相同的數(shù)量進(jìn)行合并匯總，并且要有匯總的明細(xì)數(shù)據(jù)，要求編寫(xiě)一段代碼，實(shí)現(xiàn)這樣的合并同類項(xiàng)的要求。
二、代碼：[code]Sub kf2()  ‘by:oobird
Dim d As Object, a, b, j%, w!
Dim ss$, n%, x
Me.UsedRange.Offset(3, 0) = ''
a = Sheet1.Range(Sheet1.[a4], Sheet1.[i65536].End(xlUp))
Set d = CreateObject('scripting.dictionary')
ReDim b(1 To UBound(a), 1 To 8)
For i = 1 To UBound(a)
ss = a(i, 1) & a(i, 2) & a(i, 4) & a(i, 5) & a(i, 6) & a(i, 8)
If Not d.Exists(ss) Then
n = n + 1
d.Add ss, n
b(n, 1) = a(i, 2): b(n, 2) = a(i, 5): b(n, 3) = a(i, 6): b(n, 4) = a(i, 4)
b(n, 5) = a(i, 1): b(n, 6) = a(i, 8): b(n, 7) = a(i, 9)
Else
b(d(ss), 7) = b(d(ss), 7) & '+' & a(i, 9)
End If
Next
For i = 1 To d.Count
x = Split(b(i, 7), '+')
For j = 0 To UBound(x)
w = w + x(j)
Next j
b(i, 8) = b(i, 5) * b(i, 6) * w / 100: w = 0
Next
[b4].Resize(n, 8) = b
End Sub       
[/code]三、代碼詳解
1、Dim d As Object, a, b, j%, w! ：Dim語(yǔ)句中的j% 等同于Dim j As Integer。w! 等同于Dim w As Single。類似的還有ss$ 等同于Dim ss As String。還有雙精度數(shù)據(jù)類型Double的類型聲明字符為#、貨幣數(shù)據(jù)類型Currency的類型聲明字符為@。
2、Me.UsedRange.Offset(3, 0) = '' ：Offset是Range對(duì)象的屬性，Offset(3, 0)的第一個(gè)參數(shù)是行數(shù)；第二個(gè)參數(shù)是列數(shù)，意思是往下偏移3行，列不變。Me是活動(dòng)工作表，相當(dāng)于Activesheet; UsedRange為已經(jīng)使用的單元格區(qū)域。本句可解釋為：清空第3行以下的單元格。
3、a = Sheet1.Range(Sheet1.[a4], Sheet1.[i65536].End(xlUp)) ：把原始數(shù)據(jù)所在的表1自A4以下的I列最后的非空單元格區(qū)域的值賦給變量a。
4、Set d = CreateObject('scripting.dictionary') ：創(chuàng)建字典對(duì)象d。
5、ReDim b(1 To UBound(a), 1 To 8) ：根據(jù)數(shù)組a的大小重新聲明數(shù)組b。
6、For i = 1 To UBound(a) ：在1 和數(shù)組a第一維的上界值之間逐一循環(huán)。
7、ss = a(i, 1) & a(i, 2) & a(i, 4) & a(i, 5) & a(i, 6) & a(i, 8) ：把多個(gè)條件比例、位置、項(xiàng)目名稱、大系統(tǒng)編號(hào)、小系統(tǒng)編號(hào)和相同樓層數(shù)用連接符號(hào)&連成一個(gè)字符串，然后賦給變量ss。
8、If Not d.Exists(ss) Then ：If…Then結(jié)構(gòu)利用了字典的Exists方法和Not來(lái)判斷：如果字典d里面不存在ss表示的關(guān)鍵字，那么執(zhí)行下面的語(yǔ)句。
9、n = n + 1 ：把變量n增加1以后仍然賦給n。
10、d.Add ss, n ：把ss的值作為關(guān)鍵字，n的值作為對(duì)應(yīng)的項(xiàng)一起加入字典d中。n的值實(shí)際是關(guān)鍵字的位置次序，如n=1時(shí)是第一個(gè)關(guān)鍵字；n=2時(shí)是第二個(gè)關(guān)鍵字。
11、b(n, 1) = a(i, 2): b(n, 2) = a(i, 5): b(n, 3) = a(i, 6): b(n, 4) = a(i, 4) ：為了使代碼看起來(lái)簡(jiǎn)短一些，可以用冒號(hào)”:”把多個(gè)語(yǔ)句連成一行。4個(gè)語(yǔ)句分別給數(shù)組b的各個(gè)元素賦以對(duì)應(yīng)的值。
12、b(n, 5) = a(i, 1): b(n, 6) = a(i, 8): b(n, 7) = a(i, 9) ：與上述的11條相同。
13、否則執(zhí)行這句：b(d(ss), 7) = b(d(ss), 7) & '+' & a(i, 9) ：d(ss)等于關(guān)鍵字對(duì)應(yīng)的項(xiàng)，在本例里等于對(duì)應(yīng)的n的值。本句是把圖紙長(zhǎng)度a(i, 9)用'+'連起來(lái)賦給數(shù)組b，這樣就得到了長(zhǎng)度明細(xì)一欄數(shù)據(jù)。
14、For i = 1 To d.Count ：在字典關(guān)鍵字?jǐn)?shù)目中逐一循環(huán)。
15、x = Split(b(i, 7), '+') ：運(yùn)用VBA函數(shù)Split把b(i, 7)（長(zhǎng)度明細(xì)）按照'+'分割，返回一個(gè)下標(biāo)從零開(kāi)始的一維數(shù)組x。如果要詳細(xì)了解Split函數(shù)的，可參見(jiàn)我的另一篇文章“常用VBA函數(shù)精選合集”。http://club./thread-387253-1-1.html
16、For j = 0 To UBound(x) ：在上面的x數(shù)組之間逐一循環(huán)。
17、w = w + x(j) ：把變量w加x(j)數(shù)組的一個(gè)元素以后仍然賦給w。實(shí)際得到x數(shù)組的累加值。
18、b(i, 8) = b(i, 5) * b(i, 6) * w / 100: w = 0 ：w求出后經(jīng)過(guò)按要求計(jì)算得到的值賦給數(shù)組b的第8列元素。（數(shù)量列）另一句把變量w置0。避免在新一次的循環(huán)中誤加進(jìn)去。
19、[b4].Resize(n, 8) = b ：最后把數(shù)組b賦給B4開(kāi)始的單元格區(qū)域。


代碼執(zhí)行后如圖實(shí)例6-1所示。

[ 本帖最后由 藍(lán)橋玄霜 于 2010-10-22 10:04 編輯 ]

L 5樓 藍(lán)橋玄霜 2010-10-18 12:53

實(shí)例7 實(shí)例8

實(shí)例7  字典法排序
一、問(wèn)題的提出：
A列B列是按順序排列的全部股票代碼和股票名稱，C列D列和E列F列是另外按條件篩選出來(lái)的無(wú)序的數(shù)據(jù)， 要求編寫(xiě)一段代碼，將它們排列到與A列相同的股票行里面。
二、代碼：三、代碼詳解
1、Dim d As Object, rng, i%, j%, arr ：聲明各個(gè)變量。
2、Set d = CreateObject('Scripting.Dictionary') ：創(chuàng)建字典對(duì)象d。
3、rng = Range('a3:f' & [a65536].End(xlUp).Row)  ：把A列到F列的單元格區(qū)域的值賦給變量rng。
4、ReDim arr(1 To UBound(rng), 1 To 4) ：根據(jù)數(shù)組rng的大小重新聲明動(dòng)態(tài)數(shù)組變量的大小，這里是按最大數(shù)量來(lái)聲明，可避免因聲明得小了而導(dǎo)致代碼出錯(cuò)。
5、For i = 1 To UBound(rng) ：在rng數(shù)組中逐一循環(huán)。
6、d(CStr(rng(i, 1))) = i ：把A列的股票代碼的值用VBA轉(zhuǎn)換函數(shù)CStr轉(zhuǎn)換成字符串以后作為關(guān)鍵字，因?yàn)槿绻蛔魈幚碛袝r(shí)候遇到00開(kāi)始的數(shù)據(jù)，可能會(huì)失去前面的0。股票代碼在數(shù)組中的行位置i作為關(guān)鍵字對(duì)應(yīng)的項(xiàng)，一起加入字典d。
7、For j = 3 To 5 Step 2 ：前面的循環(huán)得到了整個(gè)字典，下面這兩個(gè)循環(huán)用來(lái)與字典中的關(guān)鍵字比對(duì)而重新排位。Step 2是循環(huán)的步長(zhǎng)，j=3執(zhí)行以后，j=3+2=5，從而跳過(guò)j=4了。呵呵，這是For…Next循環(huán)結(jié)構(gòu)的基礎(chǔ)知識(shí)，說(shuō)多了。
8、For i = 1 To Cells(65536, j).End(xlUp).Row – 2 ：因?yàn)镃列和E列的最后一個(gè)非空單元格的位置不一樣，所以用了Cells(65536, j).End(xlUp).Row在循環(huán)中分別得到這兩列的最后一個(gè)非空單元格的行數(shù)，由于數(shù)組rng是從第3行開(kāi)始的，為了與下面引用的rng數(shù)組對(duì)應(yīng)，所以需要減去2。全句是在C列和E列中逐一循環(huán)。
9、If d(CStr(rng(i, j))) <> '' Then ：rng(i, j)是C列或者E列的股票代碼，本句是如果這個(gè)股票代碼關(guān)鍵字對(duì)應(yīng)的項(xiàng)不等于空的時(shí)候，執(zhí)行下面的代碼。
10、arr(d(CStr(rng(i, j))), j - 2) = rng(i, j) ：d(CStr(rng(i, j)))=i見(jiàn)上述6的解釋，表示數(shù)組arr的第1維，相當(dāng)于行；j-2是隨著j=3的時(shí)候，j-2=1；j=5的時(shí)候j-2=3，相當(dāng)于數(shù)組列的參數(shù)。把相應(yīng)的股票代碼賦給相同股票代碼的第1列或者是第3列。
11、arr(d(CStr(rng(i, j))), j - 1) = rng(i, j + 1) ：把相應(yīng)的股票名稱賦給相同股票代碼的第2列或者是第4列。
12、[c3].Resize(UBound(rng), 4) = arr ：把數(shù)組arr賦給C3開(kāi)始的單元格區(qū)域。

代碼執(zhí)行后如圖實(shí)例7-2所示。
實(shí)例8  2級(jí)動(dòng)態(tài)數(shù)據(jù)有效性問(wèn)題
一、問(wèn)題的提出：
A列是源名稱，中間有空格，B列為各個(gè)源名稱對(duì)應(yīng)的數(shù)目不同的代號(hào)，C列是目標(biāo)名稱來(lái)源于源名稱，要求在C列設(shè)置不重復(fù)的、沒(méi)有空格的數(shù)據(jù)有效性供選擇；同時(shí)D列目標(biāo)代號(hào)，要求隨著C列選擇的目標(biāo)名稱的不同，提供對(duì)應(yīng)的代號(hào)供選擇，是為第2級(jí)數(shù)據(jù)有效性。

代碼執(zhí)行前如圖實(shí)例8-1所示。
二、代碼：三、代碼詳解
1、Private Sub Worksheet_SelectionChange(ByVal Target As Range) ：本例用的是工作表選擇變化事件，只要鼠標(biāo)點(diǎn)擊單元格都會(huì)激活這個(gè)事件。Private 可譯為私有的，限制了這段代碼只能在指定的工作表里有效。參數(shù)Target聲明為單元格區(qū)域?qū)ο?，有了關(guān)鍵字ByVal，說(shuō)明可以按值傳遞參數(shù)。
2、If Target.Count > 1 Then Exit Sub  ：由于是鼠標(biāo)點(diǎn)擊單元格都會(huì)激活這個(gè)事件,所以最好要作一些限制，使得你能避免點(diǎn)擊了不需要激活事件的地方而激活本事件產(chǎn)生錯(cuò)誤。本句是如果目標(biāo)單元格的數(shù)目大于1就退出本過(guò)程。這樣當(dāng)你點(diǎn)選了多個(gè)單元格的時(shí)候，過(guò)程運(yùn)行了這句代碼就會(huì)結(jié)束過(guò)程了。
3、If Target.Column <> 4 And Target.Column <> 3 Then Exit Sub  ：再加一個(gè)限制，如果目標(biāo)單元格的列不是3列（C列）也不是4列（D列）的話就退出過(guò)程。
4、接著的四句代碼分別是聲明變量、創(chuàng)建字典對(duì)象、B列最后一個(gè)非空單元格的行數(shù)以及把單元格區(qū)域的值賦給數(shù)組變量等等與前面的實(shí)例相同。請(qǐng)注意這里選擇了B列求最后一個(gè)非空單元格的行數(shù)，是因?yàn)锳列各數(shù)據(jù)之間有空格，如果選擇A列，就會(huì)遺漏一些數(shù)據(jù)。
5、If Target.Column = 3 Then ：現(xiàn)在分兩種情況判斷，如果點(diǎn)擊的目標(biāo)單元格是C列的，那么執(zhí)行下面的代碼。
6、If Arr(i, 1) <> '' Then ：在數(shù)組Arr之間逐一循環(huán)，如果A列數(shù)組的值不等于空，就作為關(guān)鍵字加入字典d。這樣就排除了空值進(jìn)入字典。
7、With Target.Validation ：這里使用了With語(yǔ)句，With語(yǔ)句為我們提供了十分簡(jiǎn)便的對(duì)象引用手段。使用它有3個(gè)優(yōu)點(diǎn)：可以減少代碼的輸入量、增加代碼的可讀性。改善代碼的執(zhí)行效率。在End With之前的語(yǔ)句都是對(duì)目標(biāo)單元格的有效性對(duì)象的各個(gè)屬性進(jìn)行設(shè)置。
8、.Delete ：先刪除該單元格的數(shù)據(jù)有效性。注意Delete前有個(gè)小圓點(diǎn)，在小圓點(diǎn)之前就省略了Target.Validation，即減少了代碼的輸入量。這個(gè)小圓點(diǎn)不能遺漏，否則會(huì)出錯(cuò)。
9、.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, Formula1:=Join(d.keys, ',') ：Add是有效性對(duì)象的方法，向指定區(qū)域內(nèi)添加數(shù)據(jù)有效性檢驗(yàn)。參數(shù)Type是數(shù)據(jù)有效性類型，當(dāng)類型等于xlValidateList時(shí)，后面的公式1參數(shù)Formula1 必須包含以逗號(hào)分隔的取值列表。參數(shù)AlertStyle是出錯(cuò)警告樣式，這里是停止樣式；參數(shù)Operator是數(shù)據(jù)有效性運(yùn)算符，有大于、小于、大于或等于、小于或等于、介于、不介于、等于、不等于等等，這里取介于；公式1參數(shù)Formula1的值用了VBA函數(shù)Join，把字典的關(guān)鍵字用逗號(hào)分隔后連接起來(lái)賦給公式1參數(shù)。這樣，目標(biāo)單元格那的數(shù)據(jù)有效性中就沒(méi)有重復(fù)值了。
10、Target.Offset(0, 1) = '' ：給目標(biāo)單元格設(shè)置了數(shù)據(jù)有效性以后，把它同行D列單元格的值清除。這是為了確保D列的值只與C列的目標(biāo)名稱相對(duì)應(yīng)。
11、ElseIf Target.Column = 4 And Target.Offset(0, -1) <> '' Then ：否則如果目標(biāo)單元格是D列的，并且同行C列單元格不是空的情況下，執(zhí)行這下面的代碼。Offset屬性的詳解可見(jiàn)前面實(shí)例6的第2條解釋。
12、For i = 1 To UBound(Arr) ：在數(shù)組Arr之間逐一循環(huán)。
13、If Arr(i, 1) <> '' Then ：如果A列數(shù)組的值不等于空，就執(zhí)行下面的代碼。
14、r = r + 1 ：變量r累加。
15、ReDim Preserve Arr1(1 To r) ：重新聲明動(dòng)態(tài)數(shù)組的大小，Preserve是關(guān)鍵字，當(dāng)改變?cè)袛?shù)組最末維的大小時(shí)，使用此關(guān)鍵字可以保持?jǐn)?shù)組中原來(lái)的數(shù)據(jù)。這句是改變動(dòng)態(tài)數(shù)組大小的最常用語(yǔ)句，不能忘記Preserve關(guān)鍵字。
16、Arr1(r) = i ：把關(guān)鍵字在數(shù)組Arr中行的位置賦給新的動(dòng)態(tài)數(shù)組Arr1(r)。這個(gè)循環(huán)可求得A列每一個(gè)源名稱所在的行的位置。
17、For i = 1 To r ：上面的循環(huán)求得了一共有r個(gè)源名稱，逐一循環(huán)。
18、If Arr(Arr1(i), 1) = Target.Offset(0, -1).Text Then ：如果C列的目標(biāo)名稱等于源名稱時(shí)執(zhí)行下面的代碼。
19、If i <> r Then ：如果i不等于r時(shí)執(zhí)行下面的代碼。
20、js = Arr1(i + 1) – 1 ：把下一個(gè)源名稱所在的行數(shù)-1以后賦給變量js，這樣來(lái)求得每一個(gè)源名稱的開(kāi)始和結(jié)束的位置。
21、js = Myr – 1 ：否則就是最后一行－1的只賦給變量js（最后一個(gè)源名稱在數(shù)組中的位置）。
22、ks = Arr1(i) ：把數(shù)組的值賦給變量ks：得到每一個(gè)源名稱的起始位置。
23、For j = ks To js ：從每一個(gè)源名稱的起始位置到結(jié)束位置逐一循環(huán)。
24、cp = cp & Arr(j, 2) & ',' ：把相應(yīng)的代號(hào)與逗號(hào)連接起來(lái)組成的字符串賦給變量cp。
25、cp = Left(cp, Len(cp) - 1) ：用了兩個(gè)VBA函數(shù)Left和Len把去掉末位的逗號(hào)。
26、With 語(yǔ)句解釋同上，為D列單元格設(shè)置了第2級(jí)數(shù)據(jù)有效性。
27、Target = Split(cp, ',')(0) ：按照問(wèn)題的第3個(gè)要求，在目標(biāo)名稱確定后，在目標(biāo)代號(hào)相應(yīng)位置自動(dòng)生成目標(biāo)名稱的第一個(gè)代號(hào)。因?yàn)镾plit得到的是一個(gè)以0為下界的一維函數(shù)，所以它的第一個(gè)元素就用(0)來(lái)表示。

代碼執(zhí)行后如圖實(shí)例8-2所示。

[ 本帖最后由 藍(lán)橋玄霜 于 2010-10-23 21:29 編輯 ]

L 6樓 藍(lán)橋玄霜 2010-10-18 12:54

實(shí)例9 實(shí)例10

實(shí)例9  字典取行數(shù)，數(shù)組重新賦值
一、問(wèn)題的提出：
要求編寫(xiě)一段代碼，求得B列不重復(fù)的名字，其相應(yīng)的A列和D列分別用' '連起來(lái)，而相應(yīng)的E列F列的數(shù)值分別相加匯總。
代碼執(zhí)行前如圖實(shí)例8-1所示。
二、代碼：三、代碼詳解
1、R = Sheet1.UsedRange ：把表1的已經(jīng)使用了的單元格區(qū)域的值賦給變量R。
2、k = 1 ：變量k賦初值1。
3、For i = 2 To UBound(R)  ：由于第一行是表頭，所以從第2行開(kāi)始循環(huán)。
4、R(i, 2) = Replace(Replace(R(i, 2), '（', '('), '）', ')') ：由于源數(shù)據(jù)中用了不統(tǒng)一的括號(hào)，所以加了這句把里面中文括號(hào)統(tǒng)一替換為英文括號(hào)。這句用了兩次VBA函數(shù)Replace，一次替換前半個(gè)，另一次替換后半個(gè)。Replace函數(shù)有6個(gè)參數(shù)，詳細(xì)請(qǐng)查閱VBA幫助文件。如果在這里解釋，篇幅太長(zhǎng)了，也沖淡了字典的主題。
5、If d.Exists(R(i, 2)) Then ：這句用字典的Exists方法進(jìn)行判斷，如果字典中存在R(i, 2)這個(gè)關(guān)鍵字，那么執(zhí)行下面的代碼。
6、這里先解釋，Else如果上面的判斷不成立，即字典中不存在這個(gè)關(guān)鍵字時(shí)，要執(zhí)行下面的代碼。
7、k = k + 1 ：變量k+1以后再賦給k。
8、d(R(i, 2)) = i ：公司名字作為關(guān)鍵字，對(duì)應(yīng)的項(xiàng)是它所在的行，把它們加入字典d。
9、For j = 1 To UBound(R, 2) ：知道了這個(gè)關(guān)鍵字所在的行，下面這個(gè)循環(huán)就是重新給數(shù)組同一行的各個(gè)元素賦值。UBound(R, 2)是用VBA函數(shù)Ubound求得數(shù)組R的第2維的最大上界。比如本例R數(shù)組第1維的最大上界是8，有8行數(shù)據(jù)；而第2維的最大上界是6，有6列數(shù)據(jù)。本循環(huán)j就是從第1列到第6列依次循環(huán)。
10、R(k, j) = R(i, j) ：把i行j列的數(shù)組元素賦給k行j列的R數(shù)組元素。
11、R(d(R(i, 2)), 1) = R(d(R(i, 2)), 1) & ' ' & R(i, 1) ：再回來(lái)說(shuō)如果R(i, 2)這個(gè)關(guān)鍵字存在，則執(zhí)行這條代碼。在這之前，這關(guān)鍵字已經(jīng)加入字典了，它的同一行的各個(gè)數(shù)組元素也重新賦過(guò)值了，所以根據(jù)問(wèn)題的要求，把A列的數(shù)據(jù)用' '連起來(lái)再賦給A列這個(gè)數(shù)組元素。
12、R(d(R(i, 2)), 4) = R(d(R(i, 2)), 4) & ' ' & R(i, 4) ：D列數(shù)據(jù)同上。
13、R(d(R(i, 2)), 5) = Val(R(d(R(i, 2)), 5)) + R(i, 5) ：E 列數(shù)據(jù)要相加，這里用了VBA函數(shù)Val，把E列數(shù)組元素轉(zhuǎn)為數(shù)值以后相加匯總。下句類同。
14、With Sheet2 ：With語(yǔ)句，前面介紹過(guò)的。
15、.Cells.ClearContents ：清空表2所有的數(shù)據(jù)。Cells是工作表對(duì)象的屬性，指工作表所有的單元格；ClearContents是它的方法，清除里面的公式、數(shù)據(jù)，但是保留格式設(shè)置。
16、.Cells.Borders.LineStyle = xlNone ：清除表2所有的邊框。Borders是Cells的屬性，意思是單元格的邊框；LineStyle是邊框的屬性，為邊框的線型，它有直線、虛線、點(diǎn)劃線等等，這里取值xlNone是清除邊框。
17、.[a1:F1].Resize(d.Count + 1) = R ：把數(shù)組R的值賦給表2A1單元格開(kāi)始的區(qū)域。
18、.[a1:F1].Resize(d.Count + 1).Borders.LineStyle = 1 ：給這些單元格添加邊框，線型為直線。

代碼執(zhí)行后如圖實(shí)例9-2所示。

實(shí)例10  先字典求得行后顯示整行數(shù)據(jù)
一、問(wèn)題的提出：
有3列數(shù)據(jù)，要求編寫(xiě)一段代碼，如果C列名次、A列主排相同時(shí)，根據(jù)B列次排最大的只保留一行。
解題思路：先對(duì)3列數(shù)據(jù)按主要關(guān)鍵字名次_升序，次要關(guān)鍵字主排_(tái)升序，第3關(guān)鍵字次排_(tái)降序進(jìn)行排序，然后運(yùn)用字典，以”名次|主排” 作為關(guān)鍵字，它所在的行作為關(guān)鍵字的項(xiàng)加入字典，最后根據(jù)行引用相對(duì)的單元格值。

代碼執(zhí)行前如圖實(shí)例10-1所示。
二、代碼：三、代碼詳解
1、Application.ScreenUpdating = False ：關(guān)閉屏幕更新。關(guān)閉屏幕更新可加快宏的執(zhí)行速度。請(qǐng)記住當(dāng)宏結(jié)束執(zhí)行時(shí)，將 ScreenUpdating 屬性設(shè)回到 True。
2、Range('A1:C' & Myr).Sort Key1:=Range('C2'), Order1:=xlAscending, Key2:=Range('A2'), Order2:=xlAscending, Key3:=Range('B2'), Order3:=xlDescending, _
Header:=xlYes ：對(duì)ABC三列進(jìn)行排序。主要關(guān)鍵字Key1名次_升序，次要關(guān)鍵字Key2主排_(tái)升序，第3關(guān)鍵字Key3次排_(tái)降序。
3、Arr = Range('a2:c' & Myr) ：把ABC列數(shù)據(jù)賦給變量Arr。
4、For i = 1 To UBound(Arr)  ：i從1到數(shù)組Arr的最大上界逐一循環(huán)。
5、x = Arr(i, 1) & '|' & Arr(i, 3) ：把主排和”|”和名次連起來(lái)賦給變量x。
6、If Not d.exists(x) Then ：如果字典中不存在x這個(gè)關(guān)鍵字，那么執(zhí)行下面的代碼。
7、d.Add x, i + 1 ：把x作為關(guān)鍵字和這個(gè)關(guān)鍵字的具體的行作為對(duì)應(yīng)的項(xiàng)加入字典。因?yàn)閿?shù)組Arr是從A2開(kāi)始的，所以i與數(shù)據(jù)的實(shí)際行相差1，i+1就是數(shù)據(jù)的實(shí)際行。
8、[e:g].ClearContents ：清空E~G列。
9、[e2].Resize(d.Count, 1) = Application.Transpose(d.items) ：把字典所有的項(xiàng)轉(zhuǎn)置以后賦給E2單元格開(kāi)始的區(qū)域。
10、For Each rng In [e2].Resize(d.Count, 1) ：For- Each-Next控制結(jié)構(gòu)是VBA中功能最強(qiáng)的循環(huán)控制結(jié)構(gòu)，利用這個(gè)結(jié)構(gòu)可對(duì)集合中的所有對(duì)象或者數(shù)組中的所有元素進(jìn)行同一操作。它的一個(gè)優(yōu)點(diǎn)在于你不必操心循環(huán)應(yīng)該執(zhí)行多少次，它循環(huán)的次數(shù)恰好就是數(shù)組中元素的個(gè)數(shù)（或者集合中對(duì)象的個(gè)數(shù)），因此對(duì)于處理多維數(shù)組特別是處理對(duì)象時(shí)最有效率。本句意思是在E2單元格開(kāi)始的單元格區(qū)域中逐一循環(huán)。
11、rng.Resize(1, 3) = Cells(rng, 1).Resize(1, 3).Value ：把關(guān)鍵字所在行的3個(gè)單元格的值賦給rng開(kāi)始的3個(gè)單元格。在Cells(rng, 1)中作為參數(shù)的rng＝rng.Valur，而rng.Resize(1, 3)處的rng是一個(gè)單元格對(duì)象。

代碼執(zhí)行后如圖實(shí)例10-2所示。
doc文件（全）請(qǐng)到1樓下載。

[ 本帖最后由 藍(lán)橋玄霜 于 2010-10-24 19:24 編輯 ]

L 7樓 藍(lán)橋玄霜 2010-10-18 12:56

實(shí)例11 實(shí)例12

實(shí)例11  關(guān)鍵字賦給兩列后用Replace方法
一、問(wèn)題的提出：
有如圖實(shí)例11-1所示的工資表，要求編寫(xiě)一段代碼，運(yùn)用VBA自動(dòng)生成1季度的工資表。
解題思路：先把性別和姓名連起來(lái)作為關(guān)鍵字求得人員的不重復(fù)值，然后通過(guò)循環(huán)查找關(guān)鍵字獲得其各月的工資，最后用Replace方法替換兩列關(guān)鍵字區(qū)域得到各自的數(shù)據(jù)。
代碼執(zhí)行前如圖實(shí)例11-1所示。
二、代碼：三、代碼詳解
1、Arr = [a1].CurrentRegion ：把含有A1單元格的當(dāng)前單元格區(qū)域的值賦給變量Arr。CurrentRegion是Range對(duì)象的屬性，當(dāng)前區(qū)域指以任意空白行及空白列的組合為邊界的區(qū)域。如本題A11單元格有數(shù)據(jù)，但是因?yàn)榈?0行是空白行，所以沒(méi)有包含在A1的當(dāng)前區(qū)域里面。
2、For i = 1 To UBound(Arr, 2) Step 3  ：For-Next控制結(jié)構(gòu)，從1 到數(shù)組第2維的最大上界每隔3進(jìn)行一次循環(huán)，Step 3是循環(huán)的步長(zhǎng)，第一次循環(huán)時(shí)i=1；第2次循環(huán)時(shí)i=1+3=4，第3次時(shí)i=4+3=7。
3、For j = 2 To UBound(Arr)  ：從第2行開(kāi)始循環(huán)。沒(méi)有Step時(shí)默認(rèn)Step為1。
4、If Arr(j, i) <> '' Then ：If-Then-Else控制結(jié)構(gòu)可根據(jù)測(cè)試條件的結(jié)果改變程序執(zhí)行的流程。本句測(cè)試條件是Arr(j, i) <> ''，判斷性別是否為空白，如果不為空白則執(zhí)行下面的語(yǔ)句，否則，執(zhí)行Else下面的語(yǔ)句。
5、x = Arr(j, i) & '|' & Arr(j, i + 1) ：把性別和姓名中間加“|”連起來(lái)賦給變量x。
6、d(x) = '' ：把x的值作為關(guān)鍵字加入字典d。比如把”男|趙” 加入字典d。這兩個(gè)循環(huán)把每個(gè)月的所有的人員都加入了字典d，字典中的人員是沒(méi)有重復(fù)的。
7、k = d.keys ：把字典d所有的關(guān)鍵字賦給變量k。
8、[a12:i1000].ClearContents ：清空A12：I1000單元格區(qū)域。
9、[a13].Resize(d.Count, 2) = Application.Transpose(k) ：把變量k轉(zhuǎn)置之后賦給A13開(kāi)始的單元格區(qū)域。Resize是Range對(duì)象的屬性，調(diào)整指定區(qū)域的大小，其第1個(gè)參數(shù)是行的大小，d.Count表示字典關(guān)鍵字的數(shù)量，如果有10個(gè)關(guān)鍵字，那么就是10行；其第2個(gè)參數(shù)是列的大小，一般是賦給1列的，本例關(guān)鍵字由兩個(gè)數(shù)據(jù)合并而成，所以先賦給2列，后面再處理。
10、[a12:b12] = Array('性別', '姓名') ：Array是一個(gè)VBA函數(shù)，返回一個(gè)下界為0的一維數(shù)組。一維數(shù)組可以看作是水平排列的，這里作為表頭一次性輸入。
11、For i = 3 To UBound(Arr, 2) Step 3 ：從第3列開(kāi)始循環(huán)，步長(zhǎng)為3。
12、Cells(12, 2 + i / 3) = Cells(1, i) ：把“1月工資“、“2月工資“等輸入到相應(yīng)表頭的位置。
13、Set r1 = [a13].Resize(d.Count, 1).Find(x, , , 1) ：在A13單元格開(kāi)始的區(qū)域中查找字符串變量x，F(xiàn)ind方法是Range對(duì)象的一個(gè)方法，其中第4個(gè)參數(shù)值為1，其常量為xlWhole，表示精確查找，另一個(gè)常量為xlPart，它的值＝2。Find方法返回的是Range對(duì)象，所以前面要用Set語(yǔ)句來(lái)引用對(duì)象。
14、Cells(r1.Row, 2 + i / 3) = Arr(j, i) ：把關(guān)鍵字對(duì)應(yīng)的工資賦給相應(yīng)的單元格里。
15、[a13].Resize(d.Count, 1).Replace '|*', '', xlPart ：Replace方法是Range對(duì)象的一個(gè)方法，其第1個(gè)參數(shù)是要查找的字符串，這里'|*'是豎線及后面所有的字符串；其第2個(gè)參數(shù)是替換字符串，這里替換為空；其第3個(gè)參數(shù)是精確查找還是模糊查找，xlPart常量的值＝2，可以用2代替它。本句是把姓名替換掉，只留下性別；下一句把B列中的性別替換掉，只留下姓名。
代碼執(zhí)行后如圖實(shí)例11-2所示。

實(shí)例12  復(fù)雜報(bào)表匯總
一、問(wèn)題的提出：
有一日?qǐng)?bào)表，里面有生產(chǎn)型號(hào)、生產(chǎn)數(shù)量、返修原因、返修數(shù)量、報(bào)廢原因、報(bào)廢數(shù)量，要求編寫(xiě)一段代碼，按同型號(hào)產(chǎn)品匯總生產(chǎn)數(shù)量；得到同型號(hào)產(chǎn)品相同返修原因的唯一值；按同型號(hào)產(chǎn)品相同返修原因匯總返修數(shù)量； 得到同型號(hào)產(chǎn)品相同報(bào)廢原因的唯一值；同型號(hào)產(chǎn)品相同報(bào)廢原因匯總報(bào)廢數(shù)量，并且合并相同內(nèi)容的單元格。

代碼執(zhí)行前如圖實(shí)例12-1所示。
二、代碼：三、代碼詳解
1、Dim d(1 To 3) As New dictionary ：本例是前期綁定的，先引用了腳本運(yùn)行時(shí)庫(kù)，聲明了3個(gè)元素的數(shù)組為新字典。
2、x(1) = Arr(i, 2) ：把生產(chǎn)型號(hào)賦給變量x(1)。
3、d(1)(x(1)) = d(1)(x(1)) + Arr(i, 3)  ：把相同生產(chǎn)型號(hào)和它的生產(chǎn)數(shù)量加入字典d(1)，達(dá)到匯總的目的。
4、x(2) = Arr(i, 2) & '|' & Arr(i, 4)  ：把生產(chǎn)型號(hào)和返修原因連起來(lái)賦給變量x(2)。
5、d(2)(x(2)) = d(2)(x(2)) + Arr(i, 5)  ： 把相同生產(chǎn)型號(hào)和相同返修原因的返修數(shù)量加入字典d(2)，達(dá)到匯總的目的。
6、x(3) = Arr(i, 2) & '|' & Arr(i, 4) & '|' & Arr(i, 6)  ：把生產(chǎn)型號(hào)和返修原因和報(bào)廢原因連起來(lái)賦給變量x(3)。
7、d(3)(x(3)) = d(3)(x(3)) + Arr(i, 7) ：把相同生產(chǎn)型號(hào)和相同返修原因和相同報(bào)廢原因的報(bào)廢數(shù)量加入字典d(3)，達(dá)到匯總的目的。
8、For i = 1 To 3 ：用一個(gè)循環(huán)運(yùn)用字典的keys方法和items方法把3個(gè)字典的關(guān)鍵字和它們的項(xiàng)賦給對(duì)應(yīng)的變量。
9、Sheet4.Activate ：激活表4。
10、[a3:k1000].ClearContents ：清空A3：K1000單元格區(qū)域。
11、[a3:k1000].UnMerge ：將該區(qū)域所有的合并單元格分解為獨(dú)立的單元格。
12、[a3:k1000].Borders.LineStyle = xlNone ：去除該區(qū)域所有的單元格邊框。
13、[i3].Resize(d(3).Count, 1) = Application.Transpose(t(3)) ：把報(bào)廢數(shù)量匯總值的一維數(shù)組轉(zhuǎn)置后賦給I3開(kāi)始的單元格區(qū)域。
14、n = 2 ：把2賦給變量n。因?yàn)檠h(huán)中要用到n=n+1，而匯總表的起始行是第3行，所以把n的初值定為2。
15、For i = 0 To UBound(k(3)) ：在字典d(3)中逐一循環(huán)。
16、aa = Split(k(3)(i), '|') ：VBA函數(shù)Split在第6例已經(jīng)講過(guò)了。把字典d(3)的關(guān)鍵字分解后賦給變量aa。
17、n = n + 1 ：在循環(huán)中每循環(huán)一次行數(shù)就加1。
18、Cells(n, 2) = aa(0) ：把a(bǔ)a數(shù)組的第1個(gè)元素aa(0)，即生產(chǎn)型號(hào)，賦給對(duì)應(yīng)的單元格；下面兩句分別把a(bǔ)a數(shù)組的第2個(gè)元素aa(1)，即返修原因，賦給對(duì)應(yīng)的單元格；把a(bǔ)a數(shù)組的第3個(gè)元素aa(2)，即報(bào)廢原因，賦給對(duì)應(yīng)的單元格。
19、For i = 3 To n ：從第3行開(kāi)始逐行循環(huán)。
20、For j = 0 To UBound(k(1)) ：在一維數(shù)組k(1)中循環(huán)。
21、If Cells(i, 2) = k(1)(j) Then ：如果生產(chǎn)型號(hào)等于字典d(1)的關(guān)鍵字時(shí)執(zhí)行下面的語(yǔ)句。
22、Cells(i, 3) = t(1)(j) ：把這個(gè)生產(chǎn)型號(hào)的生產(chǎn)數(shù)量賦給C列單元格。
23、Cells(i, 10) = Cells(i, 9) / Cells(i, 3) ：把報(bào)廢數(shù)量除以生產(chǎn)數(shù)量得到的報(bào)廢率賦給J列單元格。
24、Cells(i, 11) = Cells(i, 10): Exit For ：把報(bào)廢率賦給K列單元格。退出For j的循環(huán)。
25、For j = 0 To UBound(k(2)) ：在一維數(shù)組k(2)中循環(huán)。
26、If Cells(i, 2) & '|' & Cells(i, 4) = k(2)(j) Then ：如果把生產(chǎn)型號(hào)和返修原因連起來(lái)的值等于字典d(2)的一個(gè)關(guān)鍵字時(shí)，執(zhí)行下面的代碼。
27、Cells(i, 5) = t(2)(j) ：把相同生產(chǎn)型號(hào)和相同返修原因的返修數(shù)量賦給E列單元格。
28、Cells(i, 6) = Cells(i, 5) / Cells(i, 3) ：把返修數(shù)量除以生產(chǎn)數(shù)量得到的返修率賦給F列單元格。
29、Cells(i, 7) = Cells(i, 6): Exit For ：把返修率賦給G列單元格。退出For j的循環(huán)。
30、Range('a3:k' & n).Sort Key1:=Range('b3'), Order1:=xlAscending, Key2:=Range('d3'), Order2:=xlAscending, Key3:=Range('h3'), Order3:=xlAscending, Header:= xlGuess ：本句開(kāi)始給表格數(shù)據(jù)設(shè)置格式了。本句是對(duì)A3開(kāi)始的單元格區(qū)域按B3_升序、D3_升序、H3_升序排序。
31、For i = 3 To n ：從第3行開(kāi)始逐行循環(huán)。
32、If Cells(i, 2) <> Cells(i - 1, 2) Then ：如果B列單元格的值與上一行單元格不相等則執(zhí)行下面的代碼。
33、r = r + 1 ：變量r加1以后賦給r。
34、ReDim Preserve Arr1(1 To r) ：重新聲明動(dòng)態(tài)數(shù)組的大小。Preserve是ReDim 語(yǔ)句的關(guān)鍵字，當(dāng)改變?cè)袛?shù)組最末維的大小時(shí)，使用此關(guān)鍵字可以保持?jǐn)?shù)組中原來(lái)的數(shù)據(jù)。
35、Arr1(r) = i ：把單元格所在的行數(shù)賦給數(shù)組。經(jīng)過(guò)這輪循環(huán)就得到了各個(gè)生產(chǎn)型號(hào)的第一行的行數(shù)。也得到了生產(chǎn)型號(hào)的總數(shù)為r個(gè)。
36、Application.DisplayAlerts = False ：把顯示警告設(shè)置為關(guān)閉，因?yàn)橄旅嬉喜卧?，Excel會(huì)顯示一個(gè)警告對(duì)話框來(lái)打斷代碼的運(yùn)行，所以先關(guān)閉此功能。
37、For j = 1 To r ：在所有的生產(chǎn)型號(hào)中逐一循環(huán)。
38、r3 = 0: r2 = 0 ：把兩個(gè)變量設(shè)置為零。
39、If j <> r Then ：如果j不等于最后一個(gè)生產(chǎn)型號(hào)時(shí)，執(zhí)行下面的代碼。
40、js = Arr1(j + 1) – 1 ：把下一個(gè)生產(chǎn)型號(hào)開(kāi)始行的上面一行的行數(shù)賦給js。
41、否則把最后一行的行數(shù)n賦給js變量。
42、ks = Arr1(j) ：把生產(chǎn)型號(hào)的開(kāi)始行的行數(shù)賦給變量ks。
43、If js - ks + 1 > 1 Then ：如果結(jié)束行減去開(kāi)始行再加1的值大于1，就說(shuō)明這個(gè)型號(hào)有多行需要合并，執(zhí)行下面的代碼。
44、Cells(ks, 1).Resize(js - ks + 1, 1).Merge ：A列對(duì)應(yīng)的單元格合并；下面B列和C列相應(yīng)的單元格也合并。
45、Cells(ks, 1) = j ：A列依次填入序號(hào)。
46、For ii = ks To js ：從開(kāi)始行到結(jié)束行逐一循環(huán)。
47、If ii = ks Then ：這個(gè)循環(huán)是為了求得D列返修原因是否有需要合并的單元格，如果ii = ks即是同一個(gè)生產(chǎn)型號(hào)中第一個(gè)返修原因的時(shí)候，把行數(shù)賦給動(dòng)態(tài)數(shù)組，否則如果不等于上一行D列單元格的值時(shí)，把行數(shù)賦給動(dòng)態(tài)數(shù)組的下一個(gè)元素。經(jīng)過(guò)這輪循環(huán)就得到了這個(gè)生產(chǎn)型號(hào)每一個(gè)返修原因的第一行的行數(shù)。也得到了返修原因的總數(shù)為r2個(gè)。
48、For ii = 1 To r2 ：在這個(gè)循環(huán)中，把D列、E 列F列相同的返修原因單元格合并，也匯總了G列的總返修率。
49、Cells(ks, 7).Resize(js - ks + 1, 1).Merge ：把G列的總返修率單元格區(qū)域合并。
50、For ii = ks To js ：從開(kāi)始行到結(jié)束行逐一循環(huán)。這個(gè)循環(huán)是為了求得H列報(bào)廢原因是否有需要合并的單元格，經(jīng)過(guò)這輪循環(huán)就得到了這個(gè)生產(chǎn)型號(hào)每一個(gè)報(bào)廢原因的第一行的行數(shù)。也得到了報(bào)廢原因的總數(shù)為r3個(gè)。
51、For ii = 1 To r3 ：在這個(gè)循環(huán)中，把H 列、I  列J 列相同的報(bào)廢原因、報(bào)廢數(shù)量和報(bào)廢率單元格合并，也匯總了K列的總報(bào)廢率。
52、Range('a3:k' & n).Borders.LineStyle = 1 ：把A3開(kāi)始的單元格區(qū)域設(shè)置邊框。
53、Application.DisplayAlerts = True ：開(kāi)啟程序顯示警告。
54、Application.ScreenUpdating = True ：開(kāi)啟屏幕更新。



代碼執(zhí)行后如圖實(shí)例12-2所示。


圖 實(shí)例12-2示例
后語(yǔ)
常見(jiàn)字典用法實(shí)例集錦到此告一段落了。字典就象一個(gè)二維數(shù)組Arr(1 to n,1 to 2)，不過(guò)它的第2維的最大上界為2，相當(dāng)于2列單元格，第1列存放的是關(guān)鍵字，這個(gè)關(guān)鍵字是除了數(shù)組以外的任何類型；第2列存放的是這個(gè)關(guān)鍵字對(duì)應(yīng)的項(xiàng)，它可以是數(shù)據(jù)的任何類型。
我收集的和接觸到有關(guān)字典的實(shí)例的數(shù)量有限，一定會(huì)有更好更有代表性的實(shí)例沒(méi)有接觸到，希望有心人能提供出來(lái)，供大家學(xué)習(xí)分享。
謝謝大家！


                                                         2010-10
全本DOC文件請(qǐng)到1樓下載。

[ 本帖最后由 藍(lán)橋玄霜 于 2010-10-24 19:29 編輯 ]

4 8樓 lzyamo3057 2010-10-18 13:01

繼續(xù)搶占沙發(fā)

2 9樓 lin82 2010-10-18 13:02

跟貼備學(xué)！謝謝！

5 10樓 yvhgydn 2010-10-18 13:05

占位置學(xué)習(xí)，不是為灌水，只為有個(gè)地兒