曼城足球论坛技术论坛

找回密码
收费注册

QQ登录

只需一步,快速发端

EH搜索
足球 Home精品图文教程库
足球 2016函数公式进修大典 制造核心竞争力的职场宝典
曼城足球论坛出品 - VBA代码宝收费下载
你的足球 2010实战技巧进修锦囊 足球 VBA典范代码实践指南
观察: 406299 | 回复: 1395
打印 上一主题 下一主题

[原创] 罕见字典用法集锦及代码详解

[复制链接]

TA的精华主题

TA的得分主题

跳转到指定楼层
1
揭晓于 2010-10-18 12:46 | 只看该作者 | 只看大图 回帖夸奖 | 倒序赏玩 | 阅读形式
本帖已被收录到常识树中,索引项: 数组集合和字典
本帖最后由 moon2778 于 2013-10-14 16:31 编辑

前言
平常上过学校的人都使用过字典,进而查到这个关键字的种种注脚,我们能够很方便的通过查找某个关键字,足球论坛哪个火。字典是上学必备的、每每查阅的工具书。有了它们,到英汉字典以及各种各样不可胜数的专业字典,重新华字典、成语词典。
平常上过EH论坛的想进修VBA内里字典用法的,从他们那里我们也学到了很多,足球论坛哪个火。同时也对很多把字典用得入迷入化的高手们致敬,足球论坛哪个火。对他们表示深深的谢意,在此,几乎都看过商量过northwolves狼版主、oobird版主的相关字典的精华贴和典范代码。我也是从这里接触到和进修到字典的。
字典对象唯有4个属性和6个方法,运转速度非常快,足球比分论坛。功能壮健,而且容易理解使用方便,绝对其它的对象要简洁得多。
本文进展通过对一些字典应用的典型实例的代码的周到注脚来给初次接触字典和想要进一步了解字典用法的朋侪提供一点备查的参考资料。,最火的足彩论坛。
给代码注释估计是公共都怕做的,请公共跟帖时指正指摘,足球论坛哪个火。还会贻误他人。足球吧论坛。所以下面的这些注释如果有不对或者不妥当的地址,稍不留心或者自己确实理解得不对,由于往往是出力不讨好的。

字典的简介
字典(Dictionary)对象是微软Windows脚本说话中的一个很有用的对象。
附带提一下。
字典对象相当于一种连结数组,它是由具有独一性的关键字(Key)和它的项(Item)连结组成。足球社区。就好像一本字典书一样。
“典”字就是具有独一性的关键字,后面的注脚就是它的项。

常用关键字英汉对照:
Dictionary 字典
Key 关键字
Item 项。


字典对象的方法有6个:Add方法、Keys方法、Items方法、Exists方法、Remove方法、RemoveAll方法。第一足球网论坛。
Add方法
向 Dictionary 对象中添加一个关键字项目对。
object.Add (key, item)
参数
object
必选项。总是一个 Dictionary 对象的称号。
key
必选项。与被添加的 item 相关联的 key。
item
必选项。与被添加的 key 相关联的 item。
说明
如果 key 已经生活。

常用语句:
Dim d
Set d = CreateObject("Scripting.Dictionary"),足球少有字典用法足球论坛哪个火集锦及代码详解。
d.Add "a", "Athens"
d.Add "b", "Belgrade"
d.Add "c", "Cairo"
代码详解
1、Dim d :制造变量,足球VBA序次开发。默许就是可变型数据类型(Variant)。曼城足球论坛技术论坛。也有写成Dim d As Object的,d后面没有写数据类型,也称为声明变量。变量d声明为可变型数据类型(Variant)。
2、Set d = CreateObject("Scripting.Dictionary"):足球。制造字典对象。
3、d.Add "a", "Athens":添加一关键字”a”和对应于它的项”Athens”。
4、d.Add "b",少有。 “Belgrade”:添加一关键字”b”和对应于它的项”Belgrade”。
5、d.Add "c",字典。 “Cairo”:添加一关键字”c”和对应于它的项”Cairo”。

Exists方法
如果 Dictionary 对象中生活所指定的关键字则返回 true。,用法。
object.Exists(key)
参数
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 = "指定的关键字已经生活。"
Else
msg = "指定的关键字不生活。"
End If
代码详解
1、Dim d, msg$ :论坛。声明变量,d见前例;msg$ 声明为字符串数据类型(String)。
2、If d.Exists("c") Then:如果字典中生活关键字”c”。
3、msg = "指定的关键字已经生活。" :哪个。把"指定的关键字已经生活。"字符串赋给变量msg。
4、Else :否则执行下面的语句。
5、msg = "指定的关键字不生活。" :集锦。把"指定的关键字不生活。"字符串赋给变量msg。
6、End If :结束If …Else…Endif剖断。

Keys方法
返回一个数组。
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 :声明变量。
2、k=d.Keys:足球。把字典中生活的所有的关键字赋给变量k。取得的是一个一维数组,下限为0。
3、[B1].Resize(d.Count,vba。1)=Application.Transpose(k) :这句代码是很常用很典范的代码。
Resize是Range对象的一个属性,由于有3个关键字。呵呵,本例d.序次。Count=3,整本字典中有几何个关键字,指的是字典中关键字的数量,开发。本例是d.Count,第一个是行数,它有两个参数,用于调整指定区域的大小。
第二个是列数,行数等于字典中关键字的数量d.Count,足球。本例是1。这样=左边的意思就是:把一个单元格B1调整为以B1发端的一列单元格区域。
=左边的k是个一维数组,必要通过Application对象的WorksheetFunction属性来使用它。论坛。所以完整的写法是Application.技术论坛。 WorksheetFunction.足球少有字典用法足球论坛哪个火集锦及代码详解。Transpose(k),用它能够把水平摆列的置换成竖向摆列。但是在VBA中不能间接使用该工作表函数,我们知道足球工作表函数内里有个转置函数Transpose,是水平摆列的。
Items方法
返回一个数组。
object.Items( )
其中 object 总是一个 Dictionary 对象的称号。

常用语句:
Dim d, t
Set d = CreateObject("Scripting.Dictionary"),足球VBA序次开发。
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 :声明变量。
2、t=d.Items :足球。把字典中所有的关键字对应的项赋给变量t。取得的也是一个一维数组,下限为0。
3、[C1].Resize(d.Count,论坛。1)=Application.Transpose(t) :有了上面Keys方法的注脚这句代码就不用多说了。

Remove方法
Remove 方法从一个 Dictionary 对象中清除一个关键字。,哪个。
object.Remove(key )
其中 object 总是一个 Dictionary 对象的称号。
key
必选项。key 与要从 Dictionary 对象中删除的关键字。
说明
如果所指定的关键字,项目对不生活。

常用语句:
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”关键字和与它对应的项。清除之后,现在字典里唯有2个关键字了。

RemoveAll方法
RemoveAll 方法从一个 Dictionary 对象中清除所有的关键字。
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:清除字典中所有的数据。也就是清空这字典,然后能够添加新的关键字和项。

字典对象的属性有4个:Count属性、Key属性、Item属性、CompareMode属性。
Count属性
返回一个Dictionary 对象中的项目数。只读属性。
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% :声明变量。
2、n = d.Count :把字典中所有的关键字的数量赋给变量n。本例取得的是3。


Key属性
在 Dictionary 对象中设置一个 key。
object.Key(key) = newkey
参数:
object
必选项。总是一个字典 (Dictionary) 对象的称号。
key
必选项。被改变的 key 值。
newkey
必选项。替换所指定的 key 的新值。
说明
如果在改变一个 key 时没有出现该 key。
常用语句:
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" :用新的关键字”d”来替换指定的关键字”c”,只相关键字d了,字典中就没相关键字c了,这时。

Item属性
在一个 Dictionary 对象中设置或者返回所指定 key 的 item。对付集合则根据所指定的 key 返回一个 item。读/写。
object.Item(key)[ = newitem]
参数
object
必选项。总是一个Dictionary 对象的称号。
key
必选项。与要被查找或添加的 item 相关联的 key。
newitem
可选项。仅适用于 Dictionary 对象;newitem 就是与所指定的 key 相关联的新值。
说明
如果在改变一个 key 的时候没有找到该 item,那么将诳骗所指定的 newitem 制造一个新的 key。如果在试图返回一个已有项目的时候没有找到 key。
常用语句:
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") :获取指定的关键字”c”对应的项。
2、MsgBox :是一个VBA函数,用信息框呈现。如果要周到了解MsgBox函数的。thread--1-1.html

CompareMode属性
设置或者返回在 Dictionary 对象及第行字符串关键字比力时所使用的比力形式。
pareMode[ = compare]
参数
object
必选项。总是一个 Dictionary 对象的称号。
compare
可选项。如果提供了此项。
说明
如果试图改变一个已经包罗罕见据的 Dictionary 对象的比力形式。
常用语句:
Dim d
Set d = CreateObject("Scripting.Dictionary")
pareMode = vbTextCompare
d.Add "a", "Athens"
d.Add "b", "Belgrade"
d.Add "c", "Cairo"
d.Add " B ", " Baltimore"
代码详解
1、pareMode = vbTextCompare :设置字典的比力形式是文本,即区分关键字的大大写,则执行二进制比力,所以上式也可写为 pareMode =1 。如果设置为vbBinaryCompare(值为0),即关键字”b”和”B”是一样的。vbTextCompare的值为1,在这种比力形式下不区分关键字的大大写。
2、d.Add " B ", " Baltimore" :添加一关键字”B”和对应于它的项”Baltimore”。由于后面已经设置了比力形式为文本形式,字典中的关键字是独一的,由于字典中已经生活”b”了,此时发生过错添加失败,即关键字”b”和”B”是一样的,不区分关键字的大大写。

[ 本帖最后由 蓝桥玄霜 于 2010-10-24 19:55 编辑 ]

罕见字典用法集锦及代码详解(全)_蓝桥玄霜.rar

1.12 MB, 下载次数

评分

参与人数 158 鲜花 +312 收起 理由
niko + 1 优越作品
zrf4112 + 2 太壮健了
km + 2 优越作品
StarLink2020 + 2 优越作品
s-excel + 2 感谢援手

观察全部评分

TA的精华主题

TA的得分主题

2
楼主 | 揭晓于 2010-10-18 12:48 | 只看该作者

实例1 普通罕见的求不重复值问题 实例2 求多表的不重复值问题

实例1 普通罕见的求不重复值问题
一、问题的提出:
表格中人员有很多是重复的,把重复的人员姓名以及重复的次数求进去,恳求编写一段代码。
  1. Sub cfz()
  2. Dim i&, Myr&, Arr
  3. Dim d, k, t
  4. Set d = CreateObject("Scripting.Dictionary")
  5. Myr = Sheet1.[a].End(xlUp).Row
  6. Arr = Sheet1.Range("a1:g" & Myr)
  7. For i = 2 To UBound(Arr)
  8. d(Arr(i, 3)) = d(Arr(i, 3)) + 1
  9. Next
  10. k = d.keys
  11. t = d.items
  12. Sheet2.Activate
  13. [a2].Resize(d.Count, 1) = Application.Transpose(k)
  14. [b2].Resize(d.Count, 1) = Application.Transpose(t)
  15. [a1].Resize(1, 2) = Array("姓名", "重复个数")
  16. Set d = Nothing
  17. End Sub
复制代码
三、代码详解
1、Dim i&, Myr&, Arr :变量i和Myr声明为长整型变量。 也能够写为 Dim Myr As Long 。Long 的类型声明字符为(&)。Arr后面没有写明数据类型。
2、Set d = CreateObject("Scripting.Dictionary"):制造字典对象。
3、Myr = Sheet1.[a].End(xlUp).Row :把表1的A列最后一行不为空白的行数赋给变量Myr。这里用了Range对象的End属性,它的值为1;xlToRight表示向右,它的值为4;xlToLeft表示向左,所以也可写成End(3)。xlDown表示向下,它的值为3,此处的xlUp表示向上,它有4个方向参数。
4、Arr = Sheet1.Range("a1:g" & Myr):把表1的A1到G列最后一行不为空白的 单元格区域的值赋给变量Arr。这样Arr就是个二维数组了。
5、For i = 2 To UBound(Arr) :For…Next循环机关,从2发端到数组的最大上界值之间循环。由于数组的第一行是表头。Ubound是VBA函数。
6、d(Arr(i, 3)) = d(Arr(i, 3)) + 1 :Arr(i,3)在本例是姓名列,也正由于有这个作用,它的项的值就增加1。起到了按关键字累加的作用,每出现一次这个关键字,d(key)等于关键字key对应的项,这句代码的意思就是把关键字”张三”插足字典,如果Arr(i,3)=”张三”,举个例子,也就是关键字列。
7、k=d.keys :把字典d中生活的所有的关键字赋给变量k。取得的是一个一维数组,上限为d.Count-1。Keys是字典的方法,下限为0。
8、t=d.items :把字典d中生活的所有的关键字对应的项赋给变量t。取得的也是一个一维数组,上限为d.Count-1。Items也是字典的方法,下限为0。
9、Sheet2.Activate :激活表2。
10、[a2].Resize(d.Count, 1) = Application.Transpose(k) :把字典d中所有的关键字赋给以a2单元格发端的单元格区域中。周到的注脚请见后面的keys方法一节。
11、[b2].Resize(d.Count, 1) = Application.Transpose(t) :把字典d中所有的关键字对应的项赋给以b2单元格发端的单元格区域中。
12、[a1].Resize(1, 2) = Array("姓名", "重复个数") :Array是一个VBA函数,返回一个下界为0的一维数组。一维数组是水平摆列的。
13、Set d = Nothing :释放字典内存。

实例2 求多表的不重复值问题
一、问题的提出:
一工作簿内里有3张工作表上,恳求编写一段代码,所有这些姓名中有些是重复的,每张表格的A列都是姓名列。
如图实例2-1所示。

图 实例2-1

这个问题也很适合用字典来解决。代码如下:
  1. Sub bcfz()
  2. Dim i&, Myr&, Arr
  3. Dim d, k, t, Sht As Worksheet
  4. Set d = CreateObject("Scripting.Dictionary")
  5. For Each Sht In Sheets
  6. If Sht.Name <> "Sheet4" Then
  7. Myr = Sht.[a].End(xlUp).Row
  8. Arr = Sht.Range("a2:a" & Myr)
  9. For i = 1 To UBound(Arr)
  10. d(Arr(i, 1)) = ""
  11. Next
  12. End If
  13. Next
  14. k = d.keys
  15. Sheet4.[a3].Resize(d.Count, 1) = Application.Transpose(k)
  16. Set d = Nothing
  17. End Sub
复制代码
三、代码详解
1、For Each Sht In Sheets :For Each…Next循环机关,这种形式是VBA特有的。
2、If Sht.Name <> "Sheet4" Then :如果这个工作表的名字不等于”Sheet4”时执行下面的代码。
3、Myr = Sht.[a].End(xlUp).Row :求得这个工作表A列罕见据的最后一行的行数,是为了制止数据很多的时候会超出整型数据类型(Integer)而出错,数据范围最大可到2,147,483,647,把它赋给变量Myr。这里用了长整型数据类型(Long)。
4、Arr = Sht.Range("a2:a" & Myr) :把A列数据赋给数组Arr。
5、For i = 1 To UBound(Arr) :For…Next循环机关,从1发端到数组的最大上限值之间循环。Ubound是VBA函数。
6、d(Arr(i, 1)) = “” :这句代码的意思就是把关键字Arr(i,1)插足字典,相当于字典中的这个关键字没有注脚。和d.Add Arr(i,1), ""的效果相同,关键字对应的项为空。
7、k=d.keys :把字典d中生活的所有的关键字赋给变量k。取得的是一个一维数组,上限为d.Count-1。Keys是字典的方法,下限为0。
8、Sheet4.[a3] .Resize(d.Count, 1) = Application.Transpose(k) :把字典d中所有的关键字赋给表4以a3单元格发端的单元格区域中。

代码执行后如图实例2-2所示。

图 实例2-2

[ 本帖最后由 蓝桥玄霜 于 2010-10-20 11:11 编辑 ]

罕见字典用法集锦及代码详解(2)_蓝桥玄霜.rar

194.03 KB, 下载次数

实例1_重复总人口1015.rar

228.3 KB, 下载次数

罕见字典用法集锦及代码详解(3)_蓝桥玄霜.rar

281.47 KB, 下载次数: 8675

实例2_不重复数0704.rar

11.46 KB, 下载次数: 8007

点评

好东西,一定要好好商量下 揭晓于 2014-6-19 07:07

评分

参与人数 17 鲜花 +35 收起 理由
愉快小仙女 + 2 太壮健了
noner + 2 太壮健了
vb喜欢者洗衣机 + 2 太壮健了
lklilo + 2 优越作品
活灵敏现12 + 2 优越作品

观察全部评分

TA的精华主题

TA的得分主题

3
楼主 | 揭晓于 2010-10-18 12:50 | 只看该作者

实例3 实例4

实例3 A列中呈现1 ~ 1000中被6除余1和余5 的数字
一、问题的提出:
有1、2、3…1000一千个数字,恳求编写一段代码。
  1. Sub 余1余5() ‘by:狼版主
  2. Dim dic As Object, i As Long, arr
  3. Set dic = CreateObject("Scripting.Dictionary")
  4. For i = 1 To 1000
  5. dic.Add i & IIf(Abs(i Mod 6 - 3) = 2, "@", ""), ""
  6. Next
  7. arr = WorksheetFunction.Transpose(Filter(dic.keys, "@"))
  8. [a1].Resize(UBound(arr), 1) = arr
  9. [a:a].Replace "@", ""
  10. Set dic = Nothing
  11. End Sub
复制代码
三、代码详解
1、Dim dic As Object, i As Long, arr :也可把字典变量dic声明为对象(Object),i As Long是规范的写法。
2、dic.Add i & IIf(Abs(i Mod 6 - 3) = 2, "@", ""), "" :这句代码的形式比力多,就把”2” 作为关键字插足字典dic,2满意足上述表达式,就把”1@” 作为关键字插足字典dic;当i=2时,1是餍足上述表达式的,关键字绝对应的项为空。比方当i=1时,返回”@”否则返回空””。 i & IIf(Abs(i Mod 6 - 3) = 2, "@", "")的意思是把这个数与”@”或者”””连起来作为关键字插足字典dic,和If…Then剖断结局类似;IIf(Abs(i Mod 6 - 3) = 2, "@", "") 这段的意思是如果符合剖断条件,Abs是取一概值函数。另一个VBA函数IIf是根据剖断条件返回结局,所以用了Abs(i Mod 6 - 3) = 2 ,为了从1到1000都同时能餍足这两个恳求,题目中有两个恳求:余1和与5,用了一个Mod运算符。i Mod 6就是每一个数除6的余数,用了两个VBA函数IIf和Abs。
3、arr = WorksheetFunction.Transpose(Filter(dic.keys, "@")) :这句代码的形式分为3部门,其下标从零发端。第2部门是用工作表函数Transpose转置这个新的一维数组,也就是把字典关键字中含有@的关键字筛选进去组成一个新的一维数组,式中的dic.keys正是一个一维数组。这里的筛选条件是”@”,如Sum、Sumif、Transpose等等。Filter函数恳求在一维数组中筛选出符合条件的另一个一维数组,我们平常使用的函数叫工作表函数,VBA函数就是能够间接在代码中使用的,第1部门是Filter(dic.keys, "@") 其中的Filter是一个VBA函数。
呵呵,狼版主的代码是短了。
4、[a1].Resize(UBound(arr), 1) = arr :把数组Arr赋给[a1]单元格发端的区域中。
5、[a:a].Replace "@", "" :把A列中的所有的@都替换为空白。

实例4 拆分数据不重复
一、问题的提出:
有一列各种手机品牌型号的数据,恳求编写一段代码。
二、代码:
  1. Sub caifen()
  2. Dim Myr&, Arr, x&
  3. Dim d, d1, d2, i&, j&
  4. Set d = CreateObject("Scripting.Dictionary")
  5. Set d1 = CreateObject("Scripting.Dictionary")
  6. Set d2 = CreateObject("Scripting.Dictionary")
  7. Myr = [a].End(xlUp).Row
  8. Arr = Range("a2:a" & Myr)
  9. Range("c2:e" & Myr).ClearContents
  10. my = Array("MOTO", "诺基亚", "三星", "索爱")
  11. gc = Array("OPPO", "联想", "天语", "金立", "步步高", "波导", "TCL", "酷派")
  12. For x = 1 To UBound(Arr)
  13. For i = 0 To UBound(my)
  14. If InStr(Arr(x, 1), my(i)) > 0 Then
  15. d(Arr(x, 1)) = ""
  16. GoTo 100
  17. End If
  18. Next i
  19. For j = 0 To UBound(gc)
  20. If InStr(Arr(x, 1), gc(j)) > 0 Then
  21. d1(Arr(x, 1)) = ""
  22. GoTo 100
  23. End If
  24. Next j
  25. d2(Arr(x, 1)) = ""
  26. 100:
  27. Next x
  28. Range("c2").Resize(UBound(d.keys) + 1, 1) = Application.Transpose(d.keys)
  29. Range("d2").Resize(UBound(d1.keys) + 1, 1) = Application.Transpose(d1.keys)
  30. Range("e2").Resize(UBound(d2.keys) + 1, 1) = Application.Transpose(d2.keys)
  31. End Sub
复制代码
三、代码详解
1、Set d2 = CreateObject("Scripting.Dictionary") :针对三个不同的种类。
2、Myr = [a].End(xlUp).Row :把A列最后一行不为空白的行数赋给变量Myr。
3、Arr = Range("a2:a" & Myr) :把A2发端的罕见据的单元格区域赋给变量Arr。
4、Range("c2:e" & Myr).ClearContents :把C2到E列单元格区域清空。
5、my = Array("MOTO", "诺基亚", "三星", "索爱") :VBA函数Array返回一个一维数组。
6、gc = Array("OPPO", "联想", "天语", "金立", "步步高", "波导", "TCL", "酷派") :把Array函数返回的数组赋给变量gc(国产两汉字的首字母)。
7、For x = 1 To UBound(Arr) :在A列原始数据的数组中逐一循环。
8、For i = 0 To UBound(my) :在my数组中逐一循环。由于有4个贸易机品牌。
9、If InStr(Arr(x, 1), my(i)) > 0 Then :VBA函数Instr返回在第1个参数中查找的位置,表示在第1个参数中没有第2个参数生活。本句的意思是如果找到贸易机品牌的话,如果返回结局=0。
10、d1(Arr(x, 1)) = "" :接上句,如果上面剖断成立。
11、GoTo 100 :Goto语句用于无条件地转移到过程中指定的行。这里采用跳出For i循环,比方"MOTO"找到的话,一是为了省略循环的次数。
12、For j循环与上面相同。
13、d2(Arr(x, 1)) = "" :如果上述两个小循环都满意足。
14、Range("c2").Resize(UBound(d.keys) + 1, 1) = Application.Transpose(d.keys) :最后的3句分别把字典的关键字数组转置后赋给相应的单元格区域。

山菊花版主用了一个字典对象就解决了上述问题。让我们来进修一下。

四、山菊花版主的代码:
  1. Sub 拆分()
  2. Dim pp1$, pp2$, nRow%, ds, Brr(), s(1 To 3) As Integer
  3. Set ds = CreateObject("scripting.dictionary")
  4. pp1 = Join(WorksheetFunction.Transpose(Range(Range("g2"), Range("g1").End(xlDown))), ",")
  5. pp2 = Join(WorksheetFunction.Transpose(Range(Range("h2"), Range("h1").End(xlDown))), ",")
  6. nRow = Range("a1").End(xlDown).Row
  7. Arr = Range("a1:a" & nRow)
  8. ReDim Brr(1 To nRow, 1 To 3)
  9. For i = 2 To nRow
  10. If Not ds.Exists(Arr(i, 1)) Then
  11. ds(Arr(i, 1)) = ""
  12. If pp1 Like "*" & Left(Arr(i, 1), 2) & "*" Then
  13. s(1) = s(1) + 1
  14. Brr(s(1), 1) = Arr(i, 1)
  15. ElseIf pp2 Like "*" & Left(Arr(i, 1), 2) & "*" Then
  16. s(2) = s(2) + 1
  17. Brr(s(2), 2) = Arr(i, 1)
  18. Else
  19. s(3) = s(3) + 1
  20. Brr(s(3), 3) = Arr(i, 1)
  21. End If
  22. End If
  23. Next
  24. Range("c2:e" & nRow) = Brr
  25. End Sub
复制代码
五、代码详解
1、pp1 = Join(WorksheetFunction.Transpose(Range(Range("g2"), _
Range("g1").End(xlDown))), ",") :
这句代码用了两个VBA函数Join 和Transpose ,后面已经先容过了。Join函数是通过连接某个数组中的多个子字符串而制造的一个字符串,造成结局出错。Transpose 转置函数,那么就会把不必要的数据带进去,如果还是用Range("g").End(xlUp),遇到空白格就停止。由于本例的G14、G15单元格有 另外的数据生活,Range("g1").End(xlDown)从G1单元格往下直到最下面的单元格。
pp2一句同上句一样,取得另一个字符串。
2、nRow = Range("a1").End(xlDown).Row :把A列最后一行不为空白的行数赋给整型变量nRow。
3、Arr = Range("a1:a" & nRow) :把A列A1发端的罕见据的单元格区域赋给变量Arr。
4、ReDim Brr(1 To nRow, 1 To 3) :用于为静态数组变量Brr重新分配存储空间。第一维的下界从1到上界nRow。
5、For i = 2 To nRow :从2到 nRow逐一循环。
6、If Not ds.Exists(Arr(i, 1)) Then :如果字典ds中不生活关键字Arr(i, 1)
7、ds(Arr(i, 1)) = "" :把Arr(i, 1)作为关键字插足字典ds。
8、If pp1 Like "*" & Left(Arr(i, 1), 2) & "*" Then :这里山版主用了比力运算符Like来比力pp1和取自Arr(i, 1)左边两个字符,如果餍足条件为真,再在前后加任意字符组成的字符串。
9、s(1) = s(1) + 1 :数组s的第一个元素+1以还赋给数组s的第一个元素。
10、Brr(s(1), 1) = Arr(i, 1) :把这个关键字赋给第2维为1的另一个数组Brr。
11、ElseIf pp2 Like "*" & Left(Arr(i, 1), 2) & "*" Then :异样,如果餍足国产品牌类这个条件。
12、s(2) = s(2) + 1 :数组s的第二个元素+1以还赋给数组s的第二个元素。
13、Brr(s(2), 2) = Arr(i, 1) :把这个关键字赋给第2维为2的另一个数组Brr。
14、s(3) = s(3) + 1 :前如果条件都满意足时。
15、Brr(s(3), 3) = Arr(i, 1) :把这个关键字赋给第3维为1的另一个数组Brr。
16、Range("c2:e" & nRow) = Brr :把数组Brr赋给[c2]单元格发端的区域中。

[ 本帖最后由 蓝桥玄霜 于 2010-10-21 10:24 编辑 ]

罕见字典用法集锦及代码详解(4)_蓝桥玄霜.rar

410.34 KB, 下载次数: 9650

常用字典用法_实例3实例4.rar

27.84 KB, 下载次数: 7094

评分

参与人数 10 鲜花 +26 收起 理由
思雪遥遥 + 2 优越作品
一念天堂 + 2 值得确定
weiyingde + 3
达州张先生 + 3 值得确定
wt577 + 2 真是把数组跟字典完善的结合在一起了

观察全部评分

TA的精华主题

TA的得分主题

4
楼主 | 揭晓于 2010-10-18 12:52 | 只看该作者

实例5 实例6

[/code]实例5 前期绑定的字典实例
一、问题的提出:
有多列多行数据,恳求编写一段代码,其中有重复的行。
如图实例5-1所示。[code]Sub 保存原数据() ‘by:ldy888
‘前期绑定。
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 :本段代码必要先援用微软的脚本运转时库Microsoft Scripting Runtime,并翻开,在添加援用对话框中选拔c:\windows\system32\scrrun.dll,或者点击赏玩,然后勾选Microsoft Scripting Runtime,从菜单-工具-援用,可在VBE窗口。
Set d = CreateObject("Scripting.Dictionary")。
2、Set d(Cells(i, 1) & "") = Range(Cells(i, 1), Cells(i, 4)) :把单元格对象插足字典,和后面的几例不一样哦。如果用Typename(d(Cells(i, 1) & "")),这里用了Set,它对应的项是同一行的单元格区域。注意。
3、t=d.items :把字典d中生活的所有的关键字对应的项赋给变量t。取得的是一个一维数组,下限为0。
4、[A11].Resize(d.Count, 4) = Application.Transpose(Application.Transpose(t)) :这句用了两次工作表转置函数Transpose之后赋给A11单元格发端的区域中。

代码执行后如图实例5-2所示。

实例6 多条件复杂汇总
一、问题的提出:
有一个表格,恳求编写一段代码,并且要有汇总的明细数据,必要对其中多个条件相同的数量举行合并汇总。
二、代码:[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.[i].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。还有双精度数据类型Double的类型声明字符为#、货币数据类型Currency的类型声明字符为@。
2、Me.UsedRange.Offset(3, 0) = "" :Offset是Range对象的属性,列不变。Me是活兴工作表,意思是往下偏移3行,Offset(3, 0)的第一个参数是行数;第二个参数是列数。
3、a = Sheet1.Range(Sheet1.[a4], Sheet1.[i].End(xlUp)) :把原始数据所在的表1自A4以下的I列最后的非空单元格区域的值赋给变量a。
4、Set d = CreateObject("scripting.dictionary") :制造字典对象d。
5、ReDim b(1 To UBound(a), 1 To 8) :根据数组a的大小重新声明数组b。
6、For i = 1 To UBound(a) :在1 和数组a第一维的上界值之间逐一循环。
7、ss = a(i, 1) & a(i, 2) & a(i, 4) & a(i, 5) & a(i, 6) & a(i, 8) :把多个条件比例、位置、项目称号、大体系编号、小体系编号和相同楼层数用连接符号&连成一个字符串。
8、If Not d.Exists(ss) Then :If…Then机关诳骗了字典的Exists方法和Not来剖断:如果字典d内里不生活ss表示的关键字。
9、n = n + 1 :把变量n增加1以还仍然赋给n。
10、d.Add ss, n :把ss的值作为关键字,n的值作为对应的项一起插足字典d中。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) :为了使代码看起来冗长一些。
12、b(n, 5) = a(i, 1): b(n, 6) = a(i, 8): b(n, 7) = a(i, 9) :与上述的11条相同。
13、否则执行这句:b(d(ss), 7) = b(d(ss), 7) & "+" & a(i, 9) :d(ss)等于关键字对应的项,在本例里等于对应的n的值。本句是把图纸长度a(i, 9)用"+"连起来赋给数组b。
14、For i = 1 To d.Count :在字典关键字数目中逐一循环。
15、x = Split(b(i, 7), "+") :运用VBA函数Split把b(i, 7)(长度明细)遵从"+"分割,返回一个下标从零发端的一维数组x。如果要周到了解Split函数的。thread--1-1.html
16、For j = 0 To UBound(x) :在上面的x数组之间逐一循环。
17、w = w + x(j) :把变量w加x(j)数组的一个元素以还仍然赋给w。实际取得x数组的累加值。
18、b(i, 8) = b(i, 5) * b(i, 6) * w / 100: w = 0 :w求出后经过按恳求计算取得的值赋给数组b的第8列元素。(数量列)另一句把变量w置0。制止在新一次的循环中误加进去。
19、[b4].Resize(n, 8) = b :最后把数组b赋给B4发端的单元格区域。


代码执行后如图实例6-1所示。

[ 本帖最后由 蓝桥玄霜 于 2010-10-22 10:04 编辑 ]

罕见字典用法集锦及代码详解(5)_蓝桥玄霜.rar

563.11 KB, 下载次数: 9042

常用字典用法_实例5实例6.rar

70.1 KB, 下载次数: 9755

评分

参与人数 2 鲜花 +5 收起 理由
231943361 + 2
达州张先生 + 3 值得确定

观察全部评分

TA的精华主题

TA的得分主题

5
楼主 | 揭晓于 2010-10-18 12:53 | 只看该作者

实例7 实例8

实例7 字典法排序
一、问题的提出:
A列B列是按顺序摆列的全部股票代码和股票称号, 恳求编写一段代码,C列D列和E列F列是另外按条件筛选进去的无序的数据。
二、代码:
  1. Private Sub CommandButton1_Click() ‘by:oobird
  2. Dim d As Object, rng, i%, j%, arr
  3. Set d = CreateObject("Scripting.Dictionary")
  4. rng = Range("a3:f" & [a].End(xlUp).Row)
  5. ReDim arr(1 To UBound(rng), 1 To 4)
  6. For i = 1 To UBound(rng)
  7. d(CStr(rng(i, 1))) = i
  8. Next i
  9. For j = 3 To 5 Step 2
  10. For i = 1 To Cells(, j).End(xlUp).Row - 2
  11. If d(CStr(rng(i, j))) <> "" Then
  12. arr(d(CStr(rng(i, j))), j - 2) = rng(i, j)
  13. arr(d(CStr(rng(i, j))), j - 1) = rng(i, j + 1)
  14. End If
  15. Next i
  16. Next j
  17. [c3].Resize(UBound(rng), 4) = arr
  18. End Sub
复制代码
三、代码详解
1、Dim d As Object, rng, i%, j%, arr :声明各个变量。
2、Set d = CreateObject("Scripting.Dictionary") :制造字典对象d。
3、rng = Range("a3:f" & [a].End(xlUp).Row) :把A列到F列的单元格区域的值赋给变量rng。
4、ReDim arr(1 To UBound(rng), 1 To 4) :根据数组rng的大小重新声明静态数组变量的大小,这里是按最大数量来声明。
5、For i = 1 To UBound(rng) :在rng数组中逐一循环。
6、d(CStr(rng(i, 1))) = i :把A列的股票代码的值用VBA转换函数CStr转换成字符串以还作为关键字,可能会失去后面的0。股票代码在数组中的行位置i作为关键字对应的项,由于如果不作治理有时候遇到00发端的数据。
7、For j = 3 To 5 Step 2 :后面的循环取得了整个字典,这是For…Next循环机关的基础常识,从而跳过j=4了。呵呵,j=3+2=5,j=3执行以还,下面这两个循环用来与字典中的关键字比对而重新排位。Step 2是循环的步长。
8、For i = 1 To Cells(, j).End(xlUp).Row – 2 :由于C列和E列的最后一个非空单元格的位置不一样,为了与下面援用的rng数组对应,由于数组rng是从第3行发端的,所以用了Cells(, j).End(xlUp).Row在循环中分别取得这两列的最后一个非空单元格的行数。
9、If d(CStr(rng(i, j))) <> "" Then :rng(i, j)是C列或者E列的股票代码,本句是如果这个股票代码关键字对应的项不等于空的时候。
10、arr(d(CStr(rng(i, j))), j - 2) = rng(i, j) :d(CStr(rng(i, j)))=i见上述6的注脚,j-2=1;j=5的时候j-2=3,相当于行;j-2是随着j=3的时候,表示数组arr的第1维。
11、arr(d(CStr(rng(i, j))), j - 1) = rng(i, j + 1) :把相应的股票称号赋给相同股票代码的第2列或者是第4列。
12、[c3].Resize(UBound(rng), 4) = arr :把数组arr赋给C3发端的单元格区域。

代码执行后如图实例7-2所示。
实例8 2级静态数据有用性问题
一、问题的提出:
A列是源称号,提供对应的代号供选拔,恳求随着C列选拔的对象称号的不同,恳求在C列设置不重复的、没有空格的数据有用性供选拔;同时D列对象代号,C列是对象称号出处于源称号,B列为各个源称号对应的数目不同的代号,中心有空格。

代码执行前如图实例8-1所示。
二、代码:
  1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  2. If Target.Count > 1 Then Exit Sub
  3. If Target.Column <> 4 And Target.Column <> 3 Then Exit Sub
  4. Dim d, i&, Myr&, Arr, r%, Arr1(), cp$, ks&, js&, j&
  5. Set d = CreateObject("Scripting.Dictionary")
  6. Myr =[b].End(xlUp).Row
  7. Arr = Range("a2:b" & Myr)
  8. If Target.Column = 3 Then
  9. For i = 1 To UBound(Arr)
  10. If Arr(i, 1) <> "" Then
  11. d(Arr(i, 1)) = ""
  12. End If
  13. Next
  14. With Target.Validation
  15. .Delete
  16. .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
  17. Operator:=xlBetween, Formula1:=Join(d.keys, ",")
  18. End With
  19. Target.Offset(0, 1) = ""
  20. ElseIf Target.Column = 4 And Target.Offset(0, -1) <> "" Then
  21. For i = 1 To UBound(Arr)
  22. If Arr(i, 1) <> "" Then
  23. r = r + 1
  24. ReDim Preserve Arr1(1 To r)
  25. Arr1(r) = i
  26. End If
  27. Next i
  28. For i = 1 To r
  29. If Arr(Arr1(i), 1) = Target.Offset(0, -1).Text Then
  30. If i <> r Then
  31. js = Arr1(i + 1) - 1
  32. Else
  33. js = Myr - 1
  34. End If
  35. ks = Arr1(i)
  36. For j = ks To js
  37. cp = cp & Arr(j, 2) & ","
  38. Next
  39. End If
  40. Next i
  41. cp = Left(cp, Len(cp) - 1)
  42. With Target.Validation
  43. .Delete
  44. .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
  45. Operator:=xlBetween, Formula1:=cp
  46. End With
  47. Target = Split(cp, ",")(0)
  48. End If
  49. Set d = Nothing
  50. End Sub
复制代码
三、代码详解
1、Private Sub Worksheet_SelectionChange(ByVal Target As Range) :本例用的是工作表选拔变化事件,有了关键字ByVal,限制了这段代码只能在指定的工作表里有用。参数Target声明为单元格区域对象,只消鼠标点击单元格都会激活这个事件。Private 可译为私有的。
2、If Target.Count > 1 Then Exit Sub :由于是鼠标点击单元格都会激活这个事件,所以最好要作一些限制,使得你能制止点击了不必要激活事件的地址而激活伎俩件出现过错。本句是如果对象单元格的数目大于1就加入本过程。这样当你点选了多个单元格的时候。
3、If Target.Column <> 4 And Target.Column <> 3 Then Exit Sub :再加一个限制。
4、接着的四句代码分别是声明变量、制造字典对象、B列最后一个非空单元格的行数以及把单元格区域的值赋给数组变量等等与后面的实例相同。请注意这里选拔了B列求最后一个非空单元格的行数,如果选拔A列,是由于A列各数据之间有空格。
5、If Target.Column = 3 Then :现在分两种情况剖断,如果点击的对象单元格是C列的。
6、If Arr(i, 1) <> "" Then :在数组Arr之间逐一循环,如果A列数组的值不等于空。
7、With Target.Validation :这里使用了With语句。
8、.Delete :先删除该单元格的数据有用性。注意Delete前有个小圆点,即省略了代码的输入量。这个小圆点不能漏掉,在小圆点之前就省略了Target.Validation。
9、.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, Formula1:=Join(d.keys, ",") :Add是有用性对象的方法,把字典的关键字用逗号分隔后连接起来赋给公式1参数。这样,这里取介于;公式1参数Formula1的值用了VBA函数Join,有大于、小于、大于或等于、小于或等于、介于、不介于、等于、不等于等等,这里是停止形式;参数Operator是数据有用性运算符,后面的公式1参数Formula1 必需包罗以逗号分隔的取值列表。参数AlertStyle是出错警卫形式,当类型等于xlValidateList时,向指定区域内添加数据有用性检验。参数Type是数据有用性类型。
10、Target.Offset(0, 1) = "" :给对象单元格设置了数据有用性以还。
11、ElseIf Target.Column = 4 And Target.Offset(0, -1) <> "" Then :否则如果对象单元格是D列的,并且同行C列单元格不是空的情况下。
12、For i = 1 To UBound(Arr) :在数组Arr之间逐一循环。
13、If Arr(i, 1) <> "" Then :如果A列数组的值不等于空。
14、r = r + 1 :变量r累加。
15、ReDim Preserve Arr1(1 To r) :重新声明静态数组的大小,使用此关键字能够连结数组中从来的数据。这句是改转折态数组大小的最常用语句,当改变原罕见组最末维的大小时,Preserve是关键字。
16、Arr1(r) = i :把关键字在数组Arr中行的位置赋给新的静态数组Arr1(r)。这个循环可求得A列每一个源称号所在的行的位置。
17、For i = 1 To r :上面的循环求得了一共有r个源称号。
18、If Arr(Arr1(i), 1) = Target.Offset(0, -1).Text Then :如果C列的对象称号等于源称号时执行下面的代码。
19、If i <> r Then :如果i不等于r时执行下面的代码。
20、js = Arr1(i + 1) – 1 :把下一个源称号所在的行数-1以还赋给变量js。
21、js = Myr – 1 :否则就是最后一行-1的只赋给变量js(最后一个源称号在数组中的位置)。
22、ks = Arr1(i) :把数组的值赋给变量ks:取得每一个源称号的起始位置。
23、For j = ks To js :从每一个源称号的起始位置到结束位置逐一循环。
24、cp = cp & Arr(j, 2) & "," :把相应的代号与逗号连接起来组成的字符串赋给变量cp。
25、cp = Left(cp, Len(cp) - 1) :用了两个VBA函数Left和Len把去掉末位的逗号。
26、With 语句注脚同上。
27、Target = Split(cp, ",")(0) :遵从问题的第3个恳求,在对象代号相应位置自动生成对象称号的第一个代号。由于Split取得的是一个以0为下界的一维函数,在对象称号确定后。

代码执行后如图实例8-2所示。

[ 本帖最后由 蓝桥玄霜 于 2010-10-23 21:29 编辑 ]

罕见字典用法集锦及代码详解(6)_蓝桥玄霜.rar

765.48 KB, 下载次数

常用字典用法_实例7实例8.rar

75.34 KB, 下载次数: 7607

评分

参与人数 3 鲜花 +6 收起 理由
龍膽草 + 2 优越作品
lin + 2
1249994139 + 2 优越作品

观察全部评分

TA的精华主题

TA的得分主题

6
楼主 | 揭晓于 2010-10-18 12:54 | 只看该作者

实例9 实例10

实例9 字典取行数,数组重新赋值
一、问题的提出:
恳求编写一段代码,其相应的A列和D列分别用" "连起来,求得B列不重复的名字。
代码执行前如图实例8-1所示。
二、代码:
  1. Sub yy() 'by:Zamyi
  2. Dim d As New Dictionary, R
  3. Dim k, i&, j&
  4. R = Sheet1.UsedRange
  5. k = 1
  6. For i = 2 To UBound(R)
  7. R(i, 2) = Replace(Replace(R(i, 2), "(", "("), ")", ")")
  8. If d.Exists(R(i, 2)) Then
  9. R(d(R(i, 2)), 1) = R(d(R(i, 2)), 1) & " " & R(i, 1)
  10. R(d(R(i, 2)), 4) = R(d(R(i, 2)), 4) & " " & R(i, 4)
  11. R(d(R(i, 2)), 5) = Val(R(d(R(i, 2)), 5)) + R(i, 5)
  12. R(d(R(i, 2)), 6) = Val(R(d(R(i, 2)), 6)) + R(i, 6)
  13. Else
  14. k = k + 1
  15. d(R(i, 2)) = i
  16. For j = 1 To UBound(R, 2)
  17. R(k, j) = R(i, j)
  18. Next
  19. End If
  20. Next
  21. With Sheet2
  22. .Cells.ClearContents
  23. .Cells.Borders.LineStyle = xlNone
  24. .[a1:F1].Resize(d.Count + 1) = R
  25. .[a1:F1].Resize(d.Count + 1).Borders.LineStyle = 1
  26. End With
  27. Set d = Nothing
  28. End Sub
复制代码
三、代码详解
1、R = Sheet1.UsedRange :把表1的已经使用了的单元格区域的值赋给变量R。
2、k = 1 :变量k赋初值1。
3、For i = 2 To UBound(R) :由于第一行是表头。
4、R(i, 2) = Replace(Replace(R(i, 2), "(", "("), ")", ")") :由于源数据中用了不同一的括号,篇幅太长了,周到请查阅VBA援手文件。如果在这里注脚,另一次替换后半个。Replace函数有6个参数,一次替换前半个,所以加了这句把内里中文括号同一替换为英文括号。这句用了两次VBA函数Replace。
5、If d.Exists(R(i, 2)) Then :这句用字典的Exists方法举行剖断,如果字典中生活R(i, 2)这个关键字。
6、这里先注脚,即字典中不生活这个关键字时,Else如果上面的剖断不成立。
7、k = k + 1 :变量k+1以还再赋给k。
8、d(R(i, 2)) = i :公司名字作为关键字,对应的项是它所在的行。
9、For j = 1 To UBound(R, 2) :知道了这个关键字所在的行,有8行数据;而第2维的最大上界是6,下面这个循环就是重新给数组同一行的各个元素赋值。UBound(R, 2)是用VBA函数Ubound求得数组R的第2维的最大上界。比方本例R数组第1维的最大上界是8。
10、R(k, j) = R(i, j) :把i行j列的数组元素赋给k行j列的R数组元素。
11、R(d(R(i, 2)), 1) = R(d(R(i, 2)), 1) & " " & R(i, 1) :再回来说如果R(i, 2)这个关键字生活,所以根据问题的恳求,它的同一行的各个数组元素也重新赋过值了,这关键字已经插足字典了,则执行这条代码。在这之前。
12、R(d(R(i, 2)), 4) = R(d(R(i, 2)), 4) & " " & R(i, 4) :D列数据同上。
13、R(d(R(i, 2)), 5) = Val(R(d(R(i, 2)), 5)) + R(i, 5) :E 列数据要相加,这里用了VBA函数Val。
14、With Sheet2 :With语句。
15、.Cells.ClearContents :清空表2所有的数据。Cells是工作表对象的属性,清除内里的公式、数据,指工作表所有的单元格;ClearContents是它的方法。
16、.Cells.Borders.LineStyle = xlNone :清除表2所有的边框。Borders是Cells的属性,它有直线、虚线、点划线等等,为边框的线型,意思是单元格的边框;LineStyle是边框的属性。
17、.[a1:F1].Resize(d.Count + 1) = R :把数组R的值赋给表2A1单元格发端的区域。
18、.[a1:F1].Resize(d.Count + 1).Borders.LineStyle = 1 :给这些单元格添加边框。

代码执行后如图实例9-2所示。

实例10 先字典求得行后呈现整行数据
一、问题的提出:
有3列数据,如果C列名次、A列主排相同时,恳求编写一段代码。
解题思路:先对3列数据按主要关键字名次_升序,它所在的行作为关键字的项插足字典,以”名次|主排” 作为关键字,然后运用字典,第3关键字次排_降序举行排序,主要关键字主排_升序。

代码执行前如图实例10-1所示。
二、代码:
  1. Sub pmc()
  2. Dim i&, Myr&, Arr
  3. Dim d, x, rng
  4. Application.ScreenUpdating = False
  5. Set d = CreateObject("Scripting.Dictionary")
  6. Sheet1.Activate
  7. Myr = [a].End(xlUp).Row
  8. Range("A1:C" & Myr).Sort Key1:=Range("C2"), Order1:=xlAscending, Key2:=Range( _
  9. "A2"), Order2:=xlAscending, Key3:=Range("B2"), Order3:=xlDescending, _
  10. Header:=xlYes
  11. Arr = Range("a2:c" & Myr)
  12. For i = 1 To UBound(Arr)
  13. x = Arr(i, 1) & "|" & Arr(i, 3)
  14. If Not d.exists(x) Then
  15. d.Add x, i + 1
  16. End If
  17. Next
  18. [e:g].ClearContents
  19. [e2].Resize(d.Count, 1) = Application.Transpose(d.items)
  20. For Each rng In [e2].Resize(d.Count, 1)
  21. rng.Resize(1, 3) = Cells(rng, 1).Resize(1, 3).Value
  22. Next
  23. Set d = Nothing
  24. Application.ScreenUpdating = True
  25. End Sub
复制代码
三、代码详解
1、Application.ScreenUpdating = False :关闭屏幕更新。关闭屏幕更新可加快宏的执行速度。请记住当宏结束执行时。
2、Range("A1:C" & Myr).Sort Key1:=Range("C2"), Order1:=xlAscending, Key2:=Range("A2"), Order2:=xlAscending, Key3:=Range("B2"), Order3:=xlDescending, _
Header:=xlYes :对ABC三枚举行排序。主要关键字Key1名次_升序,主要关键字Key2主排_升序。
3、Arr = Range("a2:c" & Myr) :把ABC列数据赋给变量Arr。
4、For i = 1 To UBound(Arr) :i从1到数组Arr的最大上界逐一循环。
5、x = Arr(i, 1) & "|" & Arr(i, 3) :把主排和”|”和名次连起来赋给变量x。
6、If Not d.exists(x) Then :如果字典中不生活x这个关键字。
7、d.Add x, i + 1 :把x作为关键字和这个关键字的的确的行作为对应的项插足字典。由于数组Arr是从A2发端的,所以i与数据的实际行相差1。
8、[e:g].ClearContents :清空E~G列。
9、[e2].Resize(d.Count, 1) = Application.Transpose(d.items) :把字典所有的项转置以还赋给E2单元格发端的区域。
10、For Each rng In [e2].Resize(d.Count, 1) :For- Each-Next掌握机关是VBA中功能最强的循环掌握机关,它循环的次数适值就是数组中元素的个数(或者集合中对象的个数),诳骗这个机关可对集合中的所有对象或者数组中的所有元素举行同一操作。它的一个所长在于你不用操心循环应当执行几何次。
11、rng.Resize(1, 3) = Cells(rng, 1).Resize(1, 3).Value :把关键字所内行的3个单元格的值赋给rng发端的3个单元格。在Cells(rng, 1)中作为参数的rng=rng.Valur。

代码执行后如图实例10-2所示。
doc文件(全)请到1楼下载。

[ 本帖最后由 蓝桥玄霜 于 2010-10-24 19:24 编辑 ]

常用字典用法_实例9实例10.rar

22.38 KB, 下载次数: 6094

评分

参与人数 1 鲜花 +2 收起 理由
lin + 2 太壮健了

观察全部评分

TA的精华主题

TA的得分主题

7
楼主 | 揭晓于 2010-10-18 12:56 | 只看该作者

实例11 实例12

实例11 关键字赋给两列后用Replace方法
一、问题的提出:
有如图实例11-1所示的工资表,恳求编写一段代码。
解题思路:先把性别和姓名连起来作为关键字求得人员的不重复值,然后通过循环查找关键字获得其各月的工资。
代码执行前如图实例11-1所示。
二、代码:
  1. Sub yy()
  2. Dim d, k, t, i&, j&, Arr, x, r1
  3. Set d = CreateObject("Scripting.Dictionary")
  4. Arr = [a1].CurrentRegion
  5. For i = 1 To UBound(Arr, 2) Step 3
  6. For j = 2 To UBound(Arr)
  7. If Arr(j, i) <> "" Then
  8. x = Arr(j, i) & "|" & Arr(j, i + 1)
  9. d(x) = ""
  10. End If
  11. Next
  12. Next
  13. k = d.keys
  14. [a12:i1000].ClearContents
  15. [a13].Resize(d.Count, 2) = Application.Transpose(k)
  16. [a12:b12] = Array("性别", "姓名")
  17. For i = 3 To UBound(Arr, 2) Step 3
  18. Cells(12, 2 + i / 3) = Cells(1, i)
  19. Next
  20. For i = 3 To UBound(Arr, 2) Step 3
  21. For j = 2 To UBound(Arr)
  22. If Arr(j, i) <> "" Then
  23. x = Arr(j, i - 2) & "|" & Arr(j, i - 1)
  24. Set r1 = [a13].Resize(d.Count, 1).Find(x, , , 1)
  25. Cells(r1.Row, 2 + i / 3) = Arr(j, i)
  26. End If
  27. Next
  28. Next
  29. [a13].Resize(d.Count, 1).Replace "|*", "", xlPart
  30. [b13].Resize(d.Count, 1).Replace "*|", "", xlPart
  31. End Sub
复制代码
三、代码详解
1、Arr = [a1].CurrentRegion :把含有A1单元格的方今单元格区域的值赋给变量Arr。CurrentRegion是Range对象的属性,但是由于第10行是空白行,方今区域指以任意空白行及空白列的组合为界线的区域。如本题A11单元格罕见据。
2、For i = 1 To UBound(Arr, 2) Step 3 :For-Next掌握机关,第一次循环时i=1;第2次循环时i=1+3=4,Step 3是循环的步长,从1 到数组第2维的最大上界每隔3举行一次循环。
3、For j = 2 To UBound(Arr) :从第2行发端循环。没有Step时默许Step为1。
4、If Arr(j, i) <> "" Then :If-Then-Else掌握机关可根据测试条件的结局改变顺序执行的流程。本句测试条件是Arr(j, i) <> "",否则,如果不为空白则执行下面的语句,剖断性别是否为空白。
5、x = Arr(j, i) & "|" & Arr(j, i + 1) :把性别和姓名中心加“|”连起来赋给变量x。
6、d(x) = "" :把x的值作为关键字插足字典d。比方把”男|赵” 插足字典d。这两个循环把每个月的所有的人员都插足了字典d。
7、k = d.keys :把字典d所有的关键字赋给变量k。
8、[a12:i1000].ClearContents :清空A12:I1000单元格区域。
9、[a13].Resize(d.Count, 2) = Application.Transpose(k) :把变量k转置之后赋给A13发端的单元格区域。Resize是Range对象的属性,所以先赋给2列,本例关键字由两个数据合并而成,一般是赋给1列的,那么就是10行;其第2个参数是列的大小,如果有10个关键字,d.Count表示字典关键字的数量,其第1个参数是行的大小,调整指定区域的大小。
10、[a12:b12] = Array("性别", "姓名") :Array是一个VBA函数,返回一个下界为0的一维数组。一维数组能够看作是水平摆列的。
11、For i = 3 To UBound(Arr, 2) Step 3 :从第3列发端循环。
12、Cells(12, 2 + i / 3) = Cells(1, i) :把“1月工资“、“2月工资“等输入到相应表头的位置。
13、Set r1 = [a13].Resize(d.Count, 1).Find(x, , , 1) :在A13单元格发端的区域中查找字符串变量x,它的值=2。Find方法返回的是Range对象,另一个常量为xlPart,表示正确查找,其常量为xlWhole,其中第4个参数值为1,Find方法是Range对象的一个方法。
14、Cells(r1.Row, 2 + i / 3) = Arr(j, i) :把关键字对应的工资赋给相应的单元格里。
15、[a13].Resize(d.Count, 1).Replace "|*", "", xlPart :Replace方法是Range对象的一个方法,只留下性别;下一句把B列中的性别替换掉,能够用2取代它。本句是把姓名替换掉,xlPart常量的值=2,这里替换为空;其第3个参数是正确查找还是含糊查找,这里"|*"是竖线及后面所有的字符串;其第2个参数是替换字符串,其第1个参数是要查找的字符串。
代码执行后如图实例11-2所示。

实例12 复杂报表汇总
一、问题的提出:
有一日报表,按同型号产品汇总生产数量;取得同型号产品相同返修原因的独一值;按同型号产品相同返修原因汇总返修数量; 取得同型号产品相同报废原因的独一值;同型号产品相同报废原因汇总报废数量,恳求编写一段代码,内里有生产型号、生产数量、返修原因、返修数量、报废原因、报废数量。

代码执行前如图实例12-1所示。
二、代码:
  1. Sub bbhz()
  2. Dim i&, Myr&, x(1 To 3), Arr, n%, aa, j&, Arr1(), r%, Arr2(), r2%, r3%, Arr3()
  3. Dim d(1 To 3) As New dictionary, k(1 To 3), t(1 To 3), js, ks, ii%, jj&, ks1, js1
  4. Application.ScreenUpdating = False
  5. Myr = Sheet1.[a].End(xlUp).Row
  6. Arr = Sheet1.Range("a3:g" & Myr)
  7. For i = 1 To UBound(Arr)
  8. x(1) = Arr(i, 2)
  9. d(1)(x(1)) = d(1)(x(1)) + Arr(i, 3)
  10. x(2) = Arr(i, 2) & "|" & Arr(i, 4)
  11. d(2)(x(2)) = d(2)(x(2)) + Arr(i, 5)
  12. x(3) = Arr(i, 2) & "|" & Arr(i, 4) & "|" & Arr(i, 6)
  13. d(3)(x(3)) = d(3)(x(3)) + Arr(i, 7)
  14. Next
  15. For i = 1 To 3
  16. k(i) = d(i).Keys
  17. t(i) = d(i).Items
  18. Next
  19. Sheet4.Activate
  20. [a3:k1000].ClearContents
  21. [a3:k1000].UnMerge
  22. [a3:k1000].Borders.LineStyle = xlNone
  23. [i3].Resize(d(3).Count, 1) = Application.Transpose(t(3))
  24. n = 2
  25. For i = 0 To UBound(k(3))
  26. aa = Split(k(3)(i), "|")
  27. n = n + 1
  28. Cells(n, 2) = aa(0)
  29. Cells(n, 4) = aa(1)
  30. Cells(n, 8) = aa(2)
  31. Next
  32. For i = 3 To n
  33. For j = 0 To UBound(k(1))
  34. If Cells(i, 2) = k(1)(j) Then
  35. Cells(i, 3) = t(1)(j)
  36. Cells(i, 10) = Cells(i, 9) / Cells(i, 3)
  37. Cells(i, 11) = Cells(i, 10): Exit For
  38. End If
  39. Next
  40. For j = 0 To UBound(k(2))
  41. If Cells(i, 2) & "|" & Cells(i, 4) = k(2)(j) Then
  42. Cells(i, 5) = t(2)(j)
  43. Cells(i, 6) = Cells(i, 5) / Cells(i, 3)
  44. Cells(i, 7) = Cells(i, 6): Exit For
  45. End If
  46. Next
  47. Next
  48. Range("a3:k" & n).Sort Key1:=Range("b3"), Order1:=xlAscending, Key2:=Range("d3") _
  49. , Order2:=xlAscending, Key3:=Range("h3"), Order3:=xlAscending, Header:= _
  50. xlGuess
  51. For i = 3 To n
  52. If Cells(i, 2) <> Cells(i - 1, 2) Then
  53. r = r + 1
  54. ReDim Preserve Arr1(1 To r)
  55. Arr1(r) = i
  56. End If
  57. Next
  58. Application.DisplayAlerts = False
  59. For j = 1 To r
  60. r3 = 0: r2 = 0
  61. If j <> r Then
  62. js = Arr1(j + 1) - 1
  63. Else
  64. js = n
  65. End If
  66. ks = Arr1(j)
  67. If js - ks + 1 > 1 Then
  68. Cells(ks, 1).Resize(js - ks + 1, 1).Merge
  69. Cells(ks, 2).Resize(js - ks + 1, 1).Merge
  70. Cells(ks, 3).Resize(js - ks + 1, 1).Merge
  71. End If
  72. Cells(ks, 1) = j
  73. For ii = ks To js
  74. If ii = ks Then
  75. r2 = r2 + 1
  76. ReDim Preserve Arr2(1 To r2)
  77. Arr2(r2) = ii
  78. ElseIf Cells(ii, 4) <> Cells(ii - 1, 4) Then
  79. r2 = r2 + 1
  80. ReDim Preserve Arr2(1 To r2)
  81. Arr2(r2) = ii
  82. End If
  83. Next
  84. For ii = 1 To r2
  85. If ii <> r2 Then
  86. js1 = Arr2(ii + 1) - 1
  87. Else
  88. js1 = js
  89. End If
  90. ks1 = Arr2(ii)
  91. If js1 - ks1 + 1 > 1 Then
  92. Cells(ks1, 4).Resize(js1 - ks1 + 1, 1).Merge
  93. For jj = ks1 To js1
  94. If jj <> ks1 Then
  95. Cells(ks, 7) = Cells(ks, 7) + Cells(jj, 7)
  96. End If
  97. Next
  98. Cells(ks1, 5).Resize(js1 - ks1 + 1, 1).Merge
  99. Cells(ks1, 6).Resize(js1 - ks1 + 1, 1).Merge
  100. Else
  101. If ii <> 1 Then
  102. Cells(ks, 7) = Cells(ks, 7) + Cells(ks1, 7)
  103. End If
  104. End If
  105. Next
  106. Cells(ks, 7).Resize(js - ks + 1, 1).Merge
  107. For ii = ks To js
  108. If ii = ks Then
  109. r3 = r3 + 1
  110. ReDim Preserve Arr3(1 To r3)
  111. Arr3(r3) = ii
  112. ElseIf Cells(ii, 8) <> Cells(ii - 1, 8) Then
  113. r3 = r3 + 1
  114. ReDim Preserve Arr3(1 To r3)
  115. Arr3(r3) = ii
  116. End If
  117. Next
  118. For ii = 1 To r3
  119. If ii <> r3 Then
  120. js1 = Arr3(ii + 1) - 1
  121. Else
  122. js1 = js
  123. End If
  124. ks1 = Arr3(ii)
  125. If js1 - ks1 + 1 > 1 Then
  126. Cells(ks1, 8).Resize(js1 - ks1 + 1, 1).Merge
  127. For jj = ks1 To js1
  128. If jj <> ks1 Then
  129. Cells(ks1, 9) = Cells(ks1, 9) + Cells(jj, 9)
  130. Cells(ks1, 10) = Cells(ks1, 10) + Cells(jj, 10)
  131. End If
  132. Cells(ks, 11) = Cells(ks, 11) + Cells(jj, 11)
  133. Next
  134. Cells(ks1, 9).Resize(js1 - ks1 + 1, 1).Merge
  135. Cells(ks1, 10).Resize(js1 - ks1 + 1, 1).Merge
  136. Else
  137. If ii <> 1 Then
  138. Cells(ks, 11) = Cells(ks, 11) + Cells(ks1, 11)
  139. End If
  140. End If
  141. Next
  142. Cells(ks, 11).Resize(js - ks + 1, 1).Merge
  143. Next
  144. Range("a3:k" & n).Borders.LineStyle = 1
  145. Application.DisplayAlerts = True
  146. Application.ScreenUpdating = True
  147. End Sub
复制代码
三、代码详解
1、Dim d(1 To 3) As New dictionary :本例是前期绑定的,先援用了脚本运转时库。
2、x(1) = Arr(i, 2) :把生产型号赋给变量x(1)。
3、d(1)(x(1)) = d(1)(x(1)) + Arr(i, 3) :把相同生产型号和它的生产数量插足字典d(1)。
4、x(2) = Arr(i, 2) & "|" & Arr(i, 4) :把生产型号和返修原因连起来赋给变量x(2)。
5、d(2)(x(2)) = d(2)(x(2)) + Arr(i, 5) : 把相同生产型号和相同返修原因的返修数量插足字典d(2)。
6、x(3) = Arr(i, 2) & "|" & Arr(i, 4) & "|" & Arr(i, 6) :把生产型号和返修原因和报废原因连起来赋给变量x(3)。
7、d(3)(x(3)) = d(3)(x(3)) + Arr(i, 7) :把相同生产型号和相同返修原因和相同报废原因的报废数量插足字典d(3)。
8、For i = 1 To 3 :用一个循环运用字典的keys方法和items方法把3个字典的关键字和它们的项赋给对应的变量。
9、Sheet4.Activate :激活表4。
10、[a3:k1000].ClearContents :清空A3:K1000单元格区域。
11、[a3:k1000].UnMerge :将该区域所有的合并单元格分解为独立的单元格。
12、[a3:k1000].Borders.LineStyle = xlNone :去除该区域所有的单元格边框。
13、[i3].Resize(d(3).Count, 1) = Application.Transpose(t(3)) :把报废数量汇总值的一维数组转置后赋给I3发端的单元格区域。
14、n = 2 :把2赋给变量n。由于循环中要用到n=n+1,而汇总表的起始行是第3行。
15、For i = 0 To UBound(k(3)) :在字典d(3)中逐一循环。
16、aa = Split(k(3)(i), "|") :VBA函数Split在第6例已经讲过了。把字典d(3)的关键字分解后赋给变量aa。
17、n = n + 1 :在循环中每循环一次行数就加1。
18、Cells(n, 2) = aa(0) :把aa数组的第1个元素aa(0),即报废原因,赋给对应的单元格;把aa数组的第3个元素aa(2),即返修原因,赋给对应的单元格;下面两句分别把aa数组的第2个元素aa(1),即生产型号。
19、For i = 3 To n :从第3行发端逐行循环。
20、For j = 0 To UBound(k(1)) :在一维数组k(1)中循环。
21、If Cells(i, 2) = k(1)(j) Then :如果生产型号等于字典d(1)的关键字时执行下面的语句。
22、Cells(i, 3) = t(1)(j) :把这个生产型号的生产数量赋给C列单元格。
23、Cells(i, 10) = Cells(i, 9) / Cells(i, 3) :把报废数量除以生产数量取得的报废率赋给J列单元格。
24、Cells(i, 11) = Cells(i, 10): Exit For :把报废率赋给K列单元格。加入For j的循环。
25、For j = 0 To UBound(k(2)) :在一维数组k(2)中循环。
26、If Cells(i, 2) & "|" & Cells(i, 4) = k(2)(j) Then :如果把生产型号和返修原因连起来的值等于字典d(2)的一个关键字时。
27、Cells(i, 5) = t(2)(j) :把相同生产型号和相同返修原因的返修数量赋给E列单元格。
28、Cells(i, 6) = Cells(i, 5) / Cells(i, 3) :把返修数量除以生产数量取得的返修率赋给F列单元格。
29、Cells(i, 7) = Cells(i, 6): Exit For :把返修率赋给G列单元格。加入For j的循环。
30、Range("a3:k" & n).Sort Key1:=Range("b3"), Order1:=xlAscending, Key2:=Range("d3"), Order2:=xlAscending, Key3:=Range("h3"), Order3:=xlAscending, Header:= xlGuess :本句发端给表格数据设置格式了。本句是对A3发端的单元格区域按B3_升序、D3_升序、H3_升序排序。
31、For i = 3 To n :从第3行发端逐行循环。
32、If Cells(i, 2) <> Cells(i - 1, 2) Then :如果B列单元格的值与上一行单元格不相等则执行下面的代码。
33、r = r + 1 :变量r加1以还赋给r。
34、ReDim Preserve Arr1(1 To r) :重新声明静态数组的大小。Preserve是ReDim 语句的关键字,当改变原罕见组最末维的大小时。
35、Arr1(r) = i :把单元格所在的行数赋给数组。经过这轮循环就取得了各个生产型号的第一行的行数。也取得了生产型号的总数为r个。
36、Application.DisplayAlerts = False :把呈现警卫设置为关闭,足球会呈现一个警卫对话框来打断代码的运转,由于下面要合并单元格。
37、For j = 1 To r :在所有的生产型号中逐一循环。
38、r3 = 0: r2 = 0 :把两个变量设置为零。
39、If j <> r Then :如果j不等于最后一个生产型号时。
40、js = Arr1(j + 1) – 1 :把下一个生产型号发端行的上面一行的行数赋给js。
41、否则把最后一行的行数n赋给js变量。
42、ks = Arr1(j) :把生产型号的发端行的行数赋给变量ks。
43、If js - ks + 1 > 1 Then :如果结束行减去发端行再加1的值大于1,就说明这个型号有多行必要合并。
44、Cells(ks, 1).Resize(js - ks + 1, 1).Merge :A列对应的单元格合并;下面B列和C列相应的单元格也合并。
45、Cells(ks, 1) = j :A列次序递次填入序号。
46、For ii = ks To js :从发端行到结束行逐一循环。
47、If ii = ks Then :这个循环是为了求得D列返修原因是否有必要合并的单元格,否则如果不等于上一行D列单元格的值时,把行数赋给静态数组,如果ii = ks即是同一个生产型号中第一个返修原因的时候。
48、For ii = 1 To r2 :在这个循环中,把D列、E 列F列相同的返修原因单元格合并。
49、Cells(ks, 7).Resize(js - ks + 1, 1).Merge :把G列的总返修率单元格区域合并。
50、For ii = ks To js :从发端行到结束行逐一循环。这个循环是为了求得H列报废原因是否有必要合并的单元格。
51、For ii = 1 To r3 :在这个循环中,把H 列、I 列J 列相同的报废原因、报废数量和报废率单元格合并。
52、Range("a3:k" & n).Borders.LineStyle = 1 :把A3发端的单元格区域设置边框。
53、Application.DisplayAlerts = True :封闭顺序呈现警卫。
54、Application.ScreenUpdating = True :封闭屏幕更新。



代码执行后如图实例12-2所示。


图 实例12-2示例
后语
罕见字典用法实例集锦到此告一段落了。字典就象一个二维数组Arr(1 to n,1 to 2),这个关键字是除了数组以外的任何类型;第2列寄存的是这个关键字对应的项,第1列寄存的是关键字,相当于2列单元格,不过它的第2维的最大上界为2。
我收集的和接触到相关字典的实例的数量无限,进展有心人能提供进去,一定会有更好更有代表性的实例没有接触到。
谢谢公共!


2010-10
全本DOC文件请到1楼下载。

[ 本帖最后由 蓝桥玄霜 于 2010-10-24 19:29 编辑 ]

常用字典用法_实例11实例12.rar

34.29 KB, 下载次数: 6914

评分

参与人数 11 财富 +50 鲜花 +20 收起 理由
wb_1027 + 2
1249994139 + 2 优越作品
花花的花花 + 2 太壮健了
hdn1000 + 2 太壮健了
isy007 + 2 感谢援手

观察全部评分

TA的精华主题

TA的得分主题

8
揭晓于 2010-10-18 13:01 | 只看该作者
继续抢占沙发

TA的精华主题

TA的得分主题

9
揭晓于 2010-10-18 13:02 | 只看该作者

TA的精华主题

TA的得分主题

10
揭晓于 2010-10-18 13:05 | 只看该作者
您必要登录后才能够回帖 登录 | 收费注册

本版积分规则

关闭

最新热点上一条 /2 下一条

关注官方微信,每天学会一个新技能

手机版|关于我们|接洽我们|曼城足球论坛

GMT+8, 2020-9-1 02:10, Processed in 0. second(s), 14 queries , Gzip On, MemCache On.

Powered by X3.4

? 1999-2020 Wooffice Inc.

本论坛群情纯属揭晓者个人定见,任何违犯国家相关法律的群情。

快速回复 返回顶部 返回列表