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

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

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

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

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


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

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

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

常用語句：
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見前例；msg$ 聲明為字符串?dāng)?shù)據(jù)類型(String)，一般寫法為Dim msg As String。String 的類型聲明字符為美元號 ($)。
2、If d.Exists('c') Then：如果字典中存在關(guān)鍵字”c”，那么執(zhí)行下面的語句。
3、msg = '指定的關(guān)鍵字已經(jīng)存在。' ：把'指定的關(guān)鍵字已經(jīng)存在。'字符串賦給變量msg。
4、Else ：否則執(zhí)行下面的語句。
5、msg = '指定的關(guān)鍵字不存在。' ：把'指定的關(guān)鍵字不存在。'字符串賦給變量msg。
6、End If ：結(jié)束If …Else…Endif判斷。

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

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

常用語句：
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見前例；t默認(rèn)是可變型數(shù)據(jù)類型(Variant)。
2、t=d.Items ：把字典中所有的關(guān)鍵字對應(yīng)的項賦給變量t。得到的也是一個一維數(shù)組，下限為0，上限為d.Count-1。這是數(shù)組的默認(rèn)形式。
3、[C1].Resize(d.Count,1)=Application.Transpose(t) ：有了上面Keys方法的解釋這句代碼就不用多說了，就是把字典中所有的關(guān)鍵字對應(yīng)的項賦給以C1單元格開始的單元格區(qū)域中。

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

常用語句：
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)鍵字和與它對應(yīng)的項。清除之后,現(xiàn)在字典里只有2個關(guān)鍵字了。

RemoveAll方法
RemoveAll 方法從一個 Dictionary 對象中清除所有的關(guān)鍵字，項目對。
object.RemoveAll( )
其中 object 總是一個 Dictionary 對象的名稱。
常用語句：
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)鍵字和項，形成一本新字典。

字典對象的屬性有4個：Count屬性、Key屬性、Item屬性、CompareMode屬性。
Count屬性
返回一個Dictionary 對象中的項目數(shù)。只讀屬性。
        object.Count
其中 object一個字典對象的名稱。
常用語句：
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見前例；n被聲明為整型數(shù)據(jù)類型(Integer)。一般寫法為Dim n As Integer 。 Integer 的類型聲明字符為百分比號 (%)。
2、n = d.Count  ：把字典中所有的關(guān)鍵字的數(shù)量賦給變量n。本例得到的是3。


Key屬性
在 Dictionary 對象中設(shè)置一個 key。
object.Key(key) = newkey
參數(shù)：
object
必選項?？偸且粋€字典 (Dictionary) 對象的名稱。
key
必選項。被改變的 key 值。
newkey
必選項。替換所指定的 key 的新值。
說明
如果在改變一個 key 時沒有發(fā)現(xiàn)該 key，那么將創(chuàng)建一個新的 key 并且其相關(guān)聯(lián)的 item 被設(shè)置為空。
常用語句：
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”來替換指定的關(guān)鍵字”c”，這時，字典中就沒有關(guān)鍵字c了，只有關(guān)鍵字d了，與d對應(yīng)的項是”Cairo”。

Item屬性
在一個 Dictionary 對象中設(shè)置或者返回所指定 key 的 item。對于集合則根據(jù)所指定的 key 返回一個 item。讀/寫。
object.Item(key)[ = newitem]
參數(shù)
object
必選項?？偸且粋€Dictionary 對象的名稱。
key
必選項。與要被查找或添加的 item 相關(guān)聯(lián)的 key。
newitem
可選項。僅適用于 Dictionary 對象；newitem 就是與所指定的 key 相關(guān)聯(lián)的新值。
說明
如果在改變一個 key 的時候沒有找到該 item，那么將利用所指定的 newitem 創(chuàng)建一個新的 key。如果在試圖返回一個已有項目的時候沒有找到 key，那么將創(chuàng)建一個新的 key 且其相關(guān)的項目被設(shè)置為空。
常用語句：
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”對應(yīng)的項。
2、MsgBox   ：是一個VBA函數(shù)，用消息框顯示。如果要詳細(xì)了解MsgBox函數(shù)的，可參見我的另一篇文章“常用VBA函數(shù)精選合集”。http://club./thread-387253-1-1.html

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

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

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

實例1 普通常見的求不重復(fù)值問題 實例2 求多表的不重復(fù)值問題

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

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

圖  實例2-1  

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

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

圖  實例2-2

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

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

實例3 實例4

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

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

山菊花版主用了一個字典對象就解決了上述問題。讓我們來學(xué)習(xí)一下。

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

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

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

實例5 實例6

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

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

實例6  多條件復(fù)雜匯總
一、問題的提出：
有一個表格，需要對其中多個條件相同的數(shù)量進(jìn)行合并匯總，并且要有匯總的明細(xì)數(shù)據(jù)，要求編寫一段代碼，實現(xiàn)這樣的合并同類項的要求。
二、代碼：[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語句中的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對象的屬性，Offset(3, 0)的第一個參數(shù)是行數(shù)；第二個參數(shù)是列數(shù)，意思是往下偏移3行，列不變。Me是活動工作表，相當(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)建字典對象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) ：把多個條件比例、位置、項目名稱、大系統(tǒng)編號、小系統(tǒng)編號和相同樓層數(shù)用連接符號&連成一個字符串，然后賦給變量ss。
8、If Not d.Exists(ss) Then ：If…Then結(jié)構(gòu)利用了字典的Exists方法和Not來判斷：如果字典d里面不存在ss表示的關(guān)鍵字，那么執(zhí)行下面的語句。
9、n = n + 1 ：把變量n增加1以后仍然賦給n。
10、d.Add ss, n ：把ss的值作為關(guān)鍵字，n的值作為對應(yīng)的項一起加入字典d中。n的值實際是關(guān)鍵字的位置次序，如n=1時是第一個關(guān)鍵字；n=2時是第二個關(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) ：為了使代碼看起來簡短一些，可以用冒號”:”把多個語句連成一行。4個語句分別給數(shù)組b的各個元素賦以對應(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)鍵字對應(yīng)的項，在本例里等于對應(yīng)的n的值。本句是把圖紙長度a(i, 9)用'+'連起來賦給數(shù)組b，這樣就得到了長度明細(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)（長度明細(xì)）按照'+'分割，返回一個下標(biāo)從零開始的一維數(shù)組x。如果要詳細(xì)了解Split函數(shù)的，可參見我的另一篇文章“常用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ù)組的一個元素以后仍然賦給w。實際得到x數(shù)組的累加值。
18、b(i, 8) = b(i, 5) * b(i, 6) * w / 100: w = 0 ：w求出后經(jīng)過按要求計算得到的值賦給數(shù)組b的第8列元素。（數(shù)量列）另一句把變量w置0。避免在新一次的循環(huán)中誤加進(jìn)去。
19、[b4].Resize(n, 8) = b ：最后把數(shù)組b賦給B4開始的單元格區(qū)域。


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

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

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

實例7 實例8

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

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

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

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

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

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

實例9 實例10

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

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

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

代碼執(zhí)行前如圖實例10-1所示。
二、代碼：三、代碼詳解
1、Application.ScreenUpdating = False ：關(guān)閉屏幕更新。關(guān)閉屏幕更新可加快宏的執(zhí)行速度。請記住當(dāng)宏結(jié)束執(zhí)行時，將 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 ：對ABC三列進(jìn)行排序。主要關(guān)鍵字Key1名次_升序，次要關(guān)鍵字Key2主排_升序，第3關(guān)鍵字Key3次排_降序。
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) ：把主排和”|”和名次連起來賦給變量x。
6、If Not d.exists(x) Then ：如果字典中不存在x這個關(guān)鍵字，那么執(zhí)行下面的代碼。
7、d.Add x, i + 1 ：把x作為關(guān)鍵字和這個關(guān)鍵字的具體的行作為對應(yīng)的項加入字典。因為數(shù)組Arr是從A2開始的，所以i與數(shù)據(jù)的實際行相差1，i+1就是數(shù)據(jù)的實際行。
8、[e:g].ClearContents ：清空E~G列。
9、[e2].Resize(d.Count, 1) = Application.Transpose(d.items) ：把字典所有的項轉(zhuǎn)置以后賦給E2單元格開始的區(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)，利用這個結(jié)構(gòu)可對集合中的所有對象或者數(shù)組中的所有元素進(jìn)行同一操作。它的一個優(yōu)點在于你不必操心循環(huán)應(yīng)該執(zhí)行多少次，它循環(huán)的次數(shù)恰好就是數(shù)組中元素的個數(shù)（或者集合中對象的個數(shù)），因此對于處理多維數(shù)組特別是處理對象時最有效率。本句意思是在E2單元格開始的單元格區(qū)域中逐一循環(huán)。
11、rng.Resize(1, 3) = Cells(rng, 1).Resize(1, 3).Value ：把關(guān)鍵字所在行的3個單元格的值賦給rng開始的3個單元格。在Cells(rng, 1)中作為參數(shù)的rng＝rng.Valur，而rng.Resize(1, 3)處的rng是一個單元格對象。

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

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

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

實例11 實例12

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

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

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



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


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


                                                         2010-10
全本DOC文件請到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í)，不是為灌水，只為有個地兒