常见字典用法集锦及代码详解
前言
凡是上过学校的人都使用过字典，从新华字典、成语词典，到英汉字典以及各种各样数不胜数的专业字典，字典是上学必备的、经常查阅的工具书。有了它们，我们可以很方便的通过查找某个关键字，进而查到这个关键字的种种解释，非常快捷实用。
凡是上过EH论坛的想学习VBA里面字典用法的，几乎都看过研究过northwolves狼版主、oobird版主的有关字典的精华贴和经典代码。我也是从这里接触到和学习到字典的，在此，对他们表示深深的谢意，同时也对很多把字典用得出神入化的高手们致敬，从他们那里我们也学到了很多，也得到了提高。
字典对象只有4个属性和6个方法，相对其它的对象要简洁得多，而且容易理解使用方便，功能强大，运行速度非常快，效率极高。深受大家的喜爱。
本文希望通过对一些字典应用的典型实例的代码的详细解释来给初次接触字典和想要进一步了解字典用法的朋友提供一点备查的参考资料，希望大家能喜欢。
给代码注释估计是大家都怕做的，因为往往是出力不讨好的，稍不留神或者自己确实理解得不对，还会贻误他人。所以下面的这些注释如果有不对或者不妥当的地方，请大家跟帖时指正批评，及时改正。
字典的简介
字典（Dictionary）对象是微软Windows脚本语言中的一个很有用的对象。
附带提一下，有名的正则表达式（RegExp）对象和能方便处理驱动器、文件夹和文件的（FileSystemObject）对象也是微软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 ：创建变量，也称为声明变量。变量d声明为可变型数据类型(Variant)，d后面没有写数据类型，默认就是可变型数据类型(Variant)。也有写成Dim d As Object的，声明为对象。
2、Set d = CreateObject("Scripting.Dictionary")：创建字典对象，并把字典对象赋给变量d。这是最常用的一句代码。所谓的“后期绑定”。用了这句代码就不用先引用c:\windows\system32\scrrun.dll了。
3、d.Add "a", "Athens"：添加一关键字”a”和对应于它的项”Athens”。
4、d.Add "b", “Belgrade”：添加一关键字”b”和对应于它的项”Belgrade”。
5、d.Add "c", “Cairo”：添加一关键字”c”和对应于它的项”Cairo”。
2
Exists方法
如果Dictionary 对象中存在所指定的关键字则返回true，否则返回false。
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)，一般写法为Dim msg As String。String的类型声明字符为美元号($)。
2、If d.Exists("c") Then：如果字典中存在关键字”c”，那么执行下面的语句。
3、msg = "指定的关键字已经存在。" ：把"指定的关键字已经存在。"字符串赋给变量msg。
4、Else ：否则执行下面的语句。
5、msg = "指定的关键字不存在。" ：把"指定的关键字不存在。"字符串赋给变量msg。
6、End If ：结束If …Else…Endif判断。
Keys方法
返回一个数组，其中包含了一个Dictionary 对象中的全部现有的关键字。
object.Keys( )
其中object 总是一个Dictionary 对象的名称。
常用语句：
3
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默认是可变型数据类型(V ariant)。
2、k=d.Keys：把字典中存在的所有的关键字赋给变量k。得到的是一个一维数组，下限为0，上限为d.Count-1。这是数组的默认形式。
3、[B1].Resize(d.Count,1)=Application.Transpose(k) ：这句代码是很常用很经典的代码，所以这里要多说一些。
Resize是Range对象的一个属性，用于调整指定区域的大小，它有两个参数，第一个是行数，本例是 d.Count，指的是字典中关键字的数量，整本字典中有多少个关键字，本例d.Count=3，因为有3个关键字。呵呵，是不是说多了。
第二个是列数，本例是1。这样＝左边的意思就是：把一个单元格B1调整为以B1开始的一列单元格区域，行数等于字典中关键字的数量d.Count，就是把单元格B1调整为单元格区域B1：B3了。
＝右边的k是个一维数组，是水平排列的，我们知道Excel工作表函数里面有个转置函数Transpose，用它可以把水平排列的置换成竖向排列。但是在VBA中不能直接使用该工作表函数，需要通过Application对象的WorksheetFunction属性来使用它。所以完整的写法是Application. WorksheetFunction.Transpose(k)，中间的WorksheetFunction可省略。现在可以解释这句代码了：把字典中所有的关键字赋给以B1单元格开始的单元格区域中。
Items方法
返回一个数组，其中包含了一个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)
4
代码详解
1、Dim d, t ：声明变量，d见前例；t默认是可变型数据类型(Variant)。
2、t=d.Items ：把字典中所有的关键字对应的项赋给变量t。得到的也是一个一维数组，下限为0，上限为d.Count-1。这是数组的默认形式。
3、[C1].Resize(d.Count,1)=Application.Transpose(t) ：有了上面Keys方法的解释这句代码就不用多说了，就是把字典中所有的关键字对应的项赋给以C1单元格开始的单元格区域中。
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"
5
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% ：声明变量，d见前例；n被声明为整型数据类型(Integer)。一般写法为Dim n As Integer 。Integer的类型声明字符为百分比号(%)。
2、n = d.Count ：把字典中所有的关键字的数量赋给变量n。本例得到的是3。
Key属性
在Dictionary 对象中设置一个key。
object.Key(key) = newkey
参数：
object
必选项。总是一个字典(Dictionary) 对象的名称。
key
必选项。被改变的key 值。
newkey
必选项。替换所指定的key 的新值。
说明
如果在改变一个key 时没有发现该key，那么将创建一个新的key 并且其相关联6
的item 被设置为空。
常用语句：
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”，这时，字典中就没有关键字c了，只有关键字d了，与d对应的项是”Cairo”。
Item属性
在一个Dictionary 对象中设置或者返回所指定key 的item。对于集合则根据所指定的key 返回一个item。读/写。
object.Item(key)[ = newitem]
参数
object
必选项。总是一个Dictionary 对象的名称。
key
必选项。与要被查找或添加的item 相关联的key。
newitem
可选项。仅适用于Dictionary 对象；newitem 就是与所指定的key 相关联的新值。
说明
如果在改变一个key 的时候没有找到该item，那么将利用所指定的newitem 创建一个新的key。如果在试图返回一个已有项目的时候没有找到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函
7
数的，可参见我的另一篇文章“常用VBA函数精选合集”。https://www.doczj.com/doc/a85997607.html,/thread-387253-1-1.html
CompareMode属性
设置或者返回在Dictionary 对象中进行字符串关键字比较时所使用的比较模式。
https://www.doczj.com/doc/a85997607.html,pareMode[ = compare]
参数
object
必选项。总是一个Dictionary 对象的名称。
compare
可选项。如果提供了此项，compare 就是一个代表比较模式的值。可以使用的值是0 (二进制)、1 (文本), 2 (数据库)。
说明
如果试图改变一个已经包含有数据的Dictionary 对象的比较模式，那么将导致一个错误。
常用语句：
Dim d
Set d = CreateObject("Scripting.Dictionary")
https://www.doczj.com/doc/a85997607.html,pareMode = vbTextCompare
d.Add "a", "Athens"
d.Add "b", "Belgrade"
d.Add "c", "Cairo"
d.Add " B ", " Baltimore"
代码详解
1、https://www.doczj.com/doc/a85997607.html,pareMode = vbTextCompare ：设置字典的比较模式是文本，在这种比较模式下不区分关键字的大小写，即关键字”b”和”B”是一样的。vbTextCompare的值为1，所以上式也可写为https://www.doczj.com/doc/a85997607.html,pareMode =1 。如果设置为vbBinaryCompare（值为0），则执行二进制比较，即区分关键字的大小写，此种情况下关键字”b”和”B”被认为是不一样的。
2、d.Add " B ", " Baltimore" ：添加一关键字”B”和对应于它的项”Baltimore”。由于前面已经设置了比较模式为文本模式，不区分关键字的大小写，即关键字”b”和”B”是一样的，此时发生错误添加失败，因为字典中已经存在”b”了，字典中的关键字是唯一的，不能添加重复的关键字。
实例1 普通常见的求不重复值问题
一、问题的提出：
8
表格中人员有很多是重复的，要求编写一段代码，把重复的人员姓名以及重复的次数求出来，复制到另一个表格中。
如图实例1－1所示。
https://www.doczj.com/doc/a85997607.html,/thread-637004-1-1.html
论坛网址：
二、代码：
Sub cfz()
Dim i&, Myr&, Arr
Dim d, k, t
Set d = CreateObject("Scripting.Dictionary")
Myr = Sheet1.[a65536].End(xlUp).Row
Arr = Sheet1.Range("a1:g" & Myr)
For i = 2 To UBound(Arr)
d(Arr(i, 3)) = d(Arr(i, 3)) + 1
Next
9
k = d.keys
t = d.items
Sheet2.Activate
[a2].Resize(d.Count, 1) = Application.Transpose(k)
[b2].Resize(d.Count, 1) = Application.Transpose(t)
[a1].Resize(1, 2) = Array("姓名", "重复个数")
Set d = Nothing
End Sub
三、代码详解
1、Dim i&, Myr&, Arr ：变量i和Myr声明为长整型变量。也可以写为Dim Myr As Long 。Long的类型声明字符为(&)。Arr后面没有写明数据类型，默认就是可变型数据类型(Variant)。
2、Set d = CreateObject("Scripting.Dictionary")：创建字典对象，并把字典对象赋给变量d。这是最常用的一句代码。所谓的“后期绑定”。用了这句代码就不用先引用c:\windows\system32\scrrun.dll了。
3、Myr = Sheet1.[a65536].End(xlUp).Row ：把表1的A列最后一行不为空白的行数赋给变量Myr。这里用了Range对象的End属性，它有4个方向参数，此处的xlUp 表示向上，它的值为3，所以也可写成End(3)。xlDown表示向下，它的值为4；xlToLeft表示向左，它的值为1；xlToRight表示向右，它的值为2。
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)在本例是姓名列，也就是关键字列，举个例子，假如Arr(i,3)=”张三”，这句代码的意思就是把关键字”张三”加入字典，d(key)等于关键字key对应的项，每出现一次这个关键字，它的项的值就增加1。起到了按关键字累加的作用，也正因为有这个作用，所以可使用字典来进行各种汇总统计。后面要讲的实例会充分的展现这个作用。
7、k=d.keys ：把字典d中存在的所有的关键字赋给变量k。得到的是一个一维数组，下限为0，上限为d.Count-1。Keys是字典的方法，前面已经讲过了。
8、t=d.items ：把字典d中存在的所有的关键字对应的项赋给变量t。得到的也是一个一维数组，下限为0，上限为 d.Count-1。Items也是字典的方法，前面也已经讲过了。
9、Sheet2.Activate ：激活表2。
10、[a2].Resize(d.Count, 1) = Application.Transpose(k) ：把字典d中所有的关键字10
赋给以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 ：释放字典内存。
代码执行后如图实例1-2所示。
图实例1-2
实例2 求多表的不重复值问题
一、问题的提出：
一工作簿里面有3张工作表上，每张表格的A列都是姓名列，所有这些姓名中有些是重复的，要求编写一段代码，在另一个工作表上显示不重复的姓名。
如图实例2－1所示。
11
12
图 实例2-1
这个问题也很适合用字典来解决。代码如下：
二、代码： Sub bcfz()
Dim i&, Myr&, Arr
Dim d, k, t, Sht As Worksheet
Set d = CreateObject("Scripting.Dictionary") For Each Sht In Sheets
If https://www.doczj.com/doc/a85997607.html, <> "Sheet4" Then Myr = Sht.[a65536].End(xlUp).Row Arr = Sht.Range("a2:a" & Myr) For i = 1 To UBound(Arr) d(Arr(i, 1)) = "" Next End If
Next
k = d.keys
Sheet4.[a3].Resize(d.Count, 1) = Application.Transpose(k)
Set d = Nothing
End Sub
三、代码详解
1、For Each Sht In Sheets ：For Each…Next循环结构，这种形式是VBA特有的，用于对对象的循环非常适用。意思是在所有的工作表中依次循环。
2、If https://www.doczj.com/doc/a85997607.html, <> "Sheet4" Then ：如果这个工作表的名字不等于”Sheet4”时执行下面的代码。
3、Myr = Sht.[a65536].End(xlUp).Row ：求得这个工作表A列有数据的最后一行的行数，把它赋给变量Myr。这里用了长整型数据类型(Long)，数据范围最大可到2,147,483,647，是为了避免数据很多的时候会超出整型数据类型(Integer)而出错，因为整型数据类型数据范围最大只到32,767。
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。得到的是一个一维数组，下限为0，上限为d.Count-1。Keys是字典的方法，前面已经讲过了。
8、Sheet4.[a3] .Resize(d.Count, 1) = Application.Transpose(k) ：把字典d中所有的关键字赋给表4以a3单元格开始的单元格区域中。
代码执行后如图实例2-2所示。
13
14
图 实例2-2
实例3 A 列中显示1 ~ 1000中被6除余1和余5 的数字
一、问题的提出：
有1、2、3…1000一千个数字，要求编写一段代码，在工作表的A 列显示这些数被6除余1和余5的数字。
二、代码：
Sub 余1余5() …by:狼版主 Dim dic As Object, i As Long, arr
Set dic = CreateObject("Scripting.Dictionary") For i = 1 To 1000
dic.Add i & IIf(Abs(i Mod 6 - 3) = 2, "@", ""), "" Next
arr = WorksheetFunction.Transpose(Filter(dic.keys, "@"))
[a1].Resize(UBound(arr), 1) = arr
[a:a].Replace "@", ""
Set dic = Nothing
End Sub
三、代码详解
1、Dim dic As Object, i As Long, arr ：也可把字典变量dic声明为对象(Object)，i As Long是规范的写法，也可写成i& 。
2、dic.Add i & IIf(Abs(i Mod 6 - 3) = 2, "@", ""), "" ：这句代码的内容比较多，用了两个VBA函数IIf和Abs，用了一个Mod运算符。i Mod 6就是每一个数除6的余数，题目中有两个要求：余1和与5，为了从1到1000都同时能满足这两个要求，所以用了Abs(i Mod 6 - 3) = 2，Abs是取绝对值函数。另一个VBA函数IIf是根据判断条件返回结果，和If…Then判断结果类似；IIf(Abs(i Mod 6 - 3) = 2, "@", "")这段的意思是如果符合判断条件，返回”@”否则返回空””。i & IIf(Abs(i Mod 6 - 3) = 2, "@", "")的意思是把这个数与”@”或者”””连起来作为关键字加入字典dic，关键字相对应的项为空。比如当i=1时，1是满足上述表达式的，就把”1@”作为关键字加入字典dic；当i=2时，2不满足上述表达式，就把”2”作为关键字加入字典dic，关键字相对应的项都为空。
3、arr = WorksheetFunction.Transpose(Filter(dic.keys, "@"))：这句代码的内容分为3部分，第1部分是Filter(dic.keys, "@")其中的Filter是一个VBA函数，VBA函数就是可以直接在代码中使用的，我们平常使用的函数叫工作表函数，如Sum、Sumif、Transpose等等。Filter函数要求在一维数组中筛选出符合条件的另一个一维数组，式中的dic.keys正是一个一维数组。这里的筛选条件是”@”，也就是把字典关键字中含有@的关键字筛选出来组成一个新的一维数组，其下标从零开始。第2部分是用工作表函数Transpose转置这个新的一维数组，工作表函数的使用在前面keys方法一节已经说过了；第2部分是把转置以后的值赋给数组变量Arr。
呵呵，狼版主的代码是短了，我的解释却太长了。
4、[a1].Resize(UBound(arr), 1) = arr：把数组Arr赋给[a1]单元格开始的区域中。
5、[a:a].Replace "@", ""：把A列中的所有的@都替换为空白，只剩下数字了。
代码详解的4代码执行后，如图实例3-1所示。
15
代码全部执行后如图实例3-2所示。
图实例3-2 示例
16
实例4 拆分数据不重复
一、问题的提出：
有一列各种手机品牌型号的数据，要求编写一段代码，按照品牌划分成没有重复数据的三大类。
二、代码：
Sub caifen()
Dim Myr&, Arr, x&
Dim d, d1, d2, i&, j&
Set d = CreateObject("Scripting.Dictionary")
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
Myr = [a65536].End(xlUp).Row
Arr = Range("a2:a" & Myr)
Range("c2:e" & Myr).ClearContents
my = Array("MOTO", "诺基亚", "三星", "索爱")
gc = Array("OPPO", "联想", "天语", "金立", "步步高", "波导", "TCL", "酷派")
For x = 1 To UBound(Arr)
For i = 0 To UBound(my)
If InStr(Arr(x, 1), my(i)) > 0 Then
d(Arr(x, 1)) = ""
GoTo 100
End If
Next i
For j = 0 To UBound(gc)
If InStr(Arr(x, 1), gc(j)) > 0 Then
d1(Arr(x, 1)) = ""
GoTo 100
End If
Next j
d2(Arr(x, 1)) = ""
100:
Next x
17
Range("c2").Resize(UBound(d.keys) + 1, 1) = Application.Transpose(d.keys)
Range("d2").Resize(UBound(d1.keys) + 1, 1) = Application.Transpose(d1.keys)
Range("e2").Resize(UBound(d2.keys) + 1, 1) = Application.Transpose(d2.keys)
End Sub
三、代码详解
1、Set d2 = CreateObject("Scripting.Dictionary")：针对三个不同的种类，创建d、d1、d2三个字典对象。
2、Myr = [a65536].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返回一个一维数
组，默认下界为0。把Array函数返回的数组赋给变量my(贸易两汉字的首字母)。
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个参数中查找的位
置，如果返回结果＝0，表示在第1个参数中没有第2个参数存在。本句的意思是如果找到贸易机品牌的话，执行下面的代码。
10、d1(Arr(x, 1)) = ""：接上句，如果上面判断成立，就把Arr(x, 1)加入字典d。
11、GoTo 100：Goto语句用于无条件地转移到过程中指定的行。这里采用跳出
For i循环，一是为了减少循环的次数，比如"MOTO"找到的话，后面3个就不需要找了；二是为了跳过两个小循环之后的其它品牌加入第3个字典的d2(Arr(x, 1)) = ""语句。
12、For j循环与上面相同，为了判断得到国产机类的字典d1。
13、d2(Arr(x, 1)) = ""：如果上述两个小循环都不满足，那么就加入其它品牌类字典
里。
14、Range("c2").Resize(UBound(d.keys) + 1, 1) = Application.Transpose(d.keys)：最
后的3句分别把字典的关键字数组转置后赋给相应的单元格区域。
代码执行后如图实例4-1所示。
18
19
图 实例4-1 示例
山菊花版主用了一个字典对象就解决了上述问题。让我们来学习一下。
四、山菊花版主的代码： Sub 拆分()
Dim pp1$, pp2$, nRow%, ds, Brr(), s(1 To 3) As Integer Set ds = CreateObject("scripting.dictionary")
pp1 = Join(WorksheetFunction.Transpose(Range(Range("g2"), Range("g1").End(xlDo wn))), ",")
pp2 = Join(WorksheetFunction.Transpose(Range(Range("h2"), Range("h1").End(xlDo wn))), ",")
nRow = Range("a1").End(xlDown).Row Arr = Range("a1:a" & nRow) ReDim Brr(1 To nRow, 1 To 3) For i = 2 To nRow
If Not ds.Exists(Arr(i, 1)) Then ds(Arr(i, 1)) = ""
If pp1 Like "*" & Left(Arr(i, 1), 2) & "*" Then s(1) = s(1) + 1
Brr(s(1), 1) = Arr(i, 1)
ElseIf pp2 Like "*" & Left(Arr(i, 1), 2) & "*" Then
s(2) = s(2) + 1
Brr(s(2), 2) = Arr(i, 1)
Else
s(3) = s(3) + 1
Brr(s(3), 3) = Arr(i, 1)
End If
End If
Next
Range("c2:e" & nRow) = Brr
End Sub
五、代码详解
1、pp1 = Join(WorksheetFunction.Transpose(Range(Range("g2"), _
Range("g1").End(xlDown))), ",")：
这句代码用了两个VBA函数Join 和Transpose ，Range("g1").End(xlDown)从G1单元格往下直到最下面的单元格，遇到空白格就停止。因为本例的G14、G15单元格有另外的数据存在，如果还是用Range("g65536").End(xlUp)，那么就会把不需要的数据带进去，造成结果出错。Transpose 转置函数，前面已经介绍过了。Join函数是通过连接某个数组中的多个子字符串而创建的一个字符串，本句代码执行后得到pp1="MOTO, 诺基亚, 三星, 索爱"。
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，第二维从1到3。
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，也就20
常见字典用法集锦及代码详解 前言 凡是上过学校的人都使用过字典，从新华字典、成语词典，到英汉字典以及各种各样数不胜数的专业字典，字典是上学必备的、经常查阅的工具书。有了它们，我们可以很方便的通过查找某个关键字，进而查到这个关键字的种种解释，非常快捷实用。 凡是上过EH论坛的想学习VBA里面字典用法的，几乎都看过研究过northwolves狼版主、oobird版主的有关字典的精华贴和经典代码。我也是从这里接触到和学习到字典的，在此，对他们表示深深的谢意，同时也对很多把字典用得出神入化的高手们致敬，从他们那里我们也学到了很多，也得到了提高。 字典对象只有4个属性和6个方法，相对其它的对象要简洁得多，而且容易理解使用方便，功能强大，运行速度非常快，效率极高。深受大家的喜爱。 本文希望通过对一些字典应用的典型实例的代码的详细解释来
给初次接触字典和想要进一步了解字典用法的朋友提供一点备查的参考资料，希望大家能喜欢。 给代码注释估计是大家都怕做的，因为往往是出力不讨好的，稍不留神或者自己确实理解得不对，还会贻误他人。所以下面的这些注释如果有不对或者不妥当的地方，请大家跟帖时指正批评，及时改正。 字典的简介 字典（Dictionary）对象是微软Windows脚本语言中的一个很有用的对象。 附带提一下，有名的正则表达式（RegExp）对象和能方便处理驱动器、文件夹和文件的（FileSystemObject）对象也是微软Windows脚本语言中的一份子。 字典对象相当于一种联合数组，它是由具有唯一性的关键字（Key）和它的项（Item）联合组成。就好像一本字典书一样，是
21-1 使用工作表的名称 this.Application.Worksheets["工作表2"].Activate(); 21-2 使用工作的索引号 this.Application.Worksheets[2].Activate(); 21-3 使用工作表的代码名称 MessageBox.Show(this.Application.ActiveSheet.CodeName); 21-4 用ActiveSheet属性引用活动工作表 this.Application.Worksheets[2].Select(); MessageBox.Show(https://www.doczj.com/doc/a85997607.html,); 22-1 选择工作表的方法 this.Application.Worksheets[2].Select(); this.Application.Worksheets[2].Activate(); 23-1 使用For遍历工作表 intwkCount = this.Application.Worksheets.Count; string s = string.Empty; for (inti = 1; i<= wkCount; i++) { s = s + this.Application.Worksheets[i].Name + "\n"; } MessageBox.Show("工作簿中含有以下工作表:" + "\n" + s); 23-2 使用ForEach语句 string s = string.Empty; foreach (Excel.Worksheetwk in this.Application.Worksheets) { s = s + https://www.doczj.com/doc/a85997607.html, + "\n"; } MessageBox.Show("工作簿中含有以下工作表:" + "\n" + s); 24-1 在工作表中向下翻页 Excel.Sheetsshs=Globals.ThisWorkbook.Worksheets; Excel.WorksheetwkThis = shs.Application.ActiveSheet; Excel.WorksheetwkNext; intwkIndex = wkThis.Index; intwkCount = shs.Count; if (wkIndex 删除B列中字符串数值少于21的单元格所在的行 Sub 删除行() r = Range("B65536").End(xlUp).Row '行数 For h = r To 1 Step -1 If Cells(h, 2) < 21 Then Cells(h, 2).EntireRow.Delete Next End Sub ------------------------- 【工作表合并】将同一工作簿中的所有工作表合并到一个工作表中 新建一个工作表，写入代码[在新建的工作表标签处右键查看代码（找不到的直接按一下alt+F11) 把下面的代码复制进去然后点上面的运行运行子程序即可]： Sub 合并当前工作簿下的所有工作表() Application.ScreenUpdating = False For j = 1 To Sheets.Count If Sheets(j).Name <> https://www.doczj.com/doc/a85997607.html, Then X = Range("A65536").End(xlUp).Row + 1 Sheets(j).UsedRange.Copy Cells(X, 1) End If Next Range("B1").Select Application.ScreenUpdating = True MsgBox "当前工作簿下的全部工作表已经合并完毕！", vbInformation, "提示" End Sub ********************************************************* 代码这样写也行： Sub c() For i = Sheets.Count To 2 Step -1 Sheets(i).Select Sheets(i).UsedRange.Copy Sheets(1).Select Cells(Cells(65000, 1).End(xlUp).Row + 1, 1).Select ActiveSheet.Paste 'Sheets(i).Delete Next i End Sub ************************************************************ 把一个工作簿中的所有表单合并成一个表单，怎么去掉重复的表头、标题行？方法如下： Excel VBA常用代码总结1 改变背景色 Range("A1"). = xlNone ColorIndex一览 改变文字颜色 Range("A1"). = 1 获取单元格 Cells(1, 2) Range("H7") 获取范围 Range(Cells(2, 3), Cells(4, 5)) Range("a1:c3") '用快捷记号引用单元格 Worksheets("Sheet1").[A1:B5] 选中某sheet Set NewSheet = Sheets("sheet1") 选中或激活某单元格 '“Range”对象的的Select方法可以选择一个或多个单元格，而Activate方法可以指定某一个单元格为活动单元格。 '下面的代码首先选择A1:E10区域，同时激活D4单元格： Range("a1:e10").Select Range("d4:e5").Activate '而对于下面的代码： Range("a1:e10").Select Range("f11:g15").Activate '由于区域A1:E10和F11:G15没有公共区域，将最终选择F11:G15，并激活F11单元格。 获得文档的路径和文件名 '路径 '名称 '路径＋名称 '或将ActiveWorkbook换成thisworkbook 隐藏文档 = False 禁止屏幕更新 = False 禁止显示提示和警告消息 = False 文件夹做成 strPath = "C:\temp\" MkDir strPath 状态栏文字表示 = "计算中" 双击单元格内容变换 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If>= 5And<= 8) Then If= "●"Then = "" Else = "●" End If Cancel = True End If End Sub 文件夹选择框方法1 Set objShell = CreateObject("") Set objFolder = (0, "文件", 0, 0) If Not objFolder Is Nothing Then path= & "\" end if VBA常用技巧代码解析 yuanzhuping 1VBA VBAVBA VBA常用 常用常用 常用技巧 技巧技巧 技巧 目录 目录目录 目录 VBA VBAVBA VBA常用技巧 常用技巧常用技巧 常用技巧 ------------------------------------------------------------------------------------------------------- 1 第1章 Range（单元格）对象 -------------------------------------------------------------------- 10 技巧1 单元格的引用方法 ---------------------------------------------------------------------- 10 1-1 使用Range属性 ----------------------------------------------------------------------- 10 1-2 使用Cells属性 ------------------------------------------------------------------------ 11 1-3 使用快捷记号 -------------------------------------------------------------------------- 11 1-4 使用Offset属性 ----------------------------------------------------------------------- 12 1-5 使用Resize属性 ----------------------------------------------------------------------- 13 1-6 使用Union方法 ----------------------------------------------------------------------- 14 1-7 使用UsedRange属性 ---------------------------------------------------------------- 14 1-8 使用CurrentRegion属性 ------------------------------------------------------------ 15 技巧2 选定单元格区域的方法---------------------------------------------------------------- 15 2-1 使用Select方法 ----------------------------------------------------------------------- 15 2-2 使用Activate方法 -------------------------------------------------------------------- 16 2-3 使用Goto方法 ------------------------------------------------------------------------- 17 技巧3 获得指定行、列中的最后一个非空单元格 -------------------------------------- 17 技巧4 定位单元格 ------------------------------------------------------------------------------- 20 用过VB的人都应该知道如何声明变量，在VBA中声明变量和VB中是完全一样的！ 使用Dim语句 Dim a as integer '声明a为整型变量 Dim a '声明a为变体变量 Dim a as string '声明a为字符串变量 Dim a as currency ,b as currency ,c as currency '声明a,b,c为货币变量 ...... 声明变量可以是：Byte、Boolean、Integer、Long、Currency、Single、Double、Decimal（当前不支持）、Date、String（只限变长字符串）、String * length（定长字符串）、Object、Variant、用户定义类型或对象类型。 强制声明变量 Option Explicit 说明：该语句必在任何过程之前出现在模块中。 声明常数 用来代替文字值。 Const ' 常数的默认状态是 Private。 Const My = 456 ' 声明 Public 常数。 Public Const MyString = "HELP" ' 声明 Private Integer 常数。 Private Const MyInt As Integer = 5 ' 在同一行里声明多个常数。 Const MyStr = "Hello", MyDouble As Double = 3.4567 选择当前单元格所在区域 在EXCEL97中，有一个十分好的功能，他就是把鼠标放置在一个有效数据单元格中，执行该段代码，你就 可以将连在一起的一片数据全部选中。只要将该段代码加入到你的模块中。 Sub My_Select Selection.CurrentRegion.Select End sub 返回当前单元格中数据删除前后空格后的值 sub my_trim msgbox Trim(ActiveCell.Value) end sub 单元格位移 sub my_offset ActiveCell.Offset(0, 1).Select'当前单元格向左移动一格 ActiveCell.Offset(0, -1).Select'当前单元格向右移动一格 ActiveCell.Offset(1 , 0).Select'当前单元格向下移动一格 ActiveCell.Offset(-1 , 0).Select'当前单元格向上移动一格 end sub 如果上述程序产生错误那是因为单元格不能移动，为了解除上述错误，我们可以往 sub my_offset 之下加一段代码 on error resume next 注意以下代码都不再添加sub “代码名称” 和end sub请自己添加! 给当前单元格赋值 ActiveCell.Value = "你好！！！" 给指定单元格赋值 例如：Ａ１单元格内容设为"ＨＥＬＬＯ" Range("a1").value="hello" 又如：你现在的工作簿在sheet1上，你要往sheet2的Ａ１单元格中插入"ＨＥＬＬＯ" 1. sheets("sheet2").select Excel VBA常用代码VSTO版(C#) 1-1使用Range属性 this.Range["A3:F6, B1:C5"].Select(); 1-2使用Cells属性 for(int icell=1;icell<=100;icell++) { this.Application.Worksheets[2].cells[icell, 1].value = icell; } 1-3使用快捷记号 #N/A 1-4使用Offset属性 this.Range["A1:A3"].Offset[3, 3].Select(); 1-5使用Resize属性 this.Range["A1"].Resize[3, 3].Select(); 1-6使用Union属性 this.Application.Union(this.Range["A1:D4"], this.Range["E5:H8"]).Select(); 1-7使用UsedRange属性 https://www.doczj.com/doc/a85997607.html,edRange.Select(); 1-8使用CurrentRegion属性 this.Range["A5"].CurrentRegion.Select(); 2-1 使用Select方法 this.Application.Worksheets[3].Activate(); this.Application.Worksheets[3].Range["A1:B10"].Select(); 2-2 使用Activate方法 this.Application.Worksheets[3].Activate(); this.Application.Worksheets[3].Range["A1:B10"].Activate(); 注:此处的代码,可以运行,但是只会选中A1这一个单元格 2-3 使用Goto方法 excel代码大全.txt第一次笑是因为遇见你，第一次哭是因为你不在，第一次笑着流泪是因为不能拥有你。EXCEL宏代码大全 本文件部分文章来源于网络，文章版权归原作者所有，如果本站转载的文章侵犯了您的权益请及时联系我们，我们将尽快妥善处理。本站除部分特别声明禁止转载的专稿外，其他文章可以自由转载，但请务必注明原出处和作者。 000. A列半角内容变红 Sub A列半角内容变红() Dim rg As Range, i As Long = False For Each rg In (xlCellTypeConstants, 3) For i = 1 To Len(rg) If Asc(Mid(rg, i, 1)) 001. A列等于A列减B列 Sub A列等于A列减B列() For i = 1 To 23 Cells(i, 1) = Cells(i, 1) - Cells(i, 2) Next End Sub 002. B列录入数据时在A列返回记录时间（工作表代码） Public Sub Worksheet_Change(ByVal Target As Range) If = 2 Then (, -1) = Now End If End Sub 003. Excel宏常用代码 本大类暂没有内容，以下是关于本类的所有记录集。 004. Sub 以当前日期为名称另存文件() Filename:=Date & ".xls" End Sub 005. Sub 启用保存() ("File").Controls(4).Enabled = True ("File").Controls(5).Enabled = True End Sub 006. Sub 执行前需要验证密码的宏() Excel VBA编程的常用代码 用过VB的人都应该知道如何声明变量，在VBA中声明变量和VB中是完全一样的！ 使用Dim语句 Dim a as integer '声明a为整型变量 Dim a '声明a为变体变量 Dim a as string '声明a为字符串变量 Dim a as currency ,b as currency ,c as currency '声明a,b,c为货币变量 ...... 声明变量可以是：Byte、Boolean、Integer、Long、Currency、Single、Double、Decimal （当前不支持）、Date、String（只限变长字符串）、String * length（定长字符串）、Object、Variant、用户定义类型或对象类型。 强制声明变量 Option Explicit 说明：该语句必在任何过程之前出现在模块中。 声明常数 用来代替文字值。 Const ' 常数的默认状态是Private。 Const My = 456 ' 声明Public 常数。 Public Const MyString = "HELP" ' 声明Private Integer 常数。 Private Const MyInt As Integer = 5 ' 在同一行里声明多个常数。 Const MyStr = "Hello", MyDouble As Double = 3.4567 选择当前单元格所在区域 在EXCEL97中，有一个十分好的功能，他就是把鼠标放置在一个有效数据单元格中，执行该段代码，你就可以将连在一起的一片数据全部选中。只要将该段代码加入到你的模块中。 Sub My_Select Selection.CurrentRegion.Select End sub 返回当前单元格中数据删除前后空格后的值 sub my_trim msgbox Trim(ActiveCell.Value) Excel VBA 常用代码50例 001。用命令按扭打印一个sheet1中B2:M30区域中的内容? 我想在Sheet2中制件一个命令按扭, 打印表Sheet1中的[B2:M30] 区域中的内容? 解答：可以将打印区域设为b2：m30，然后打印，如：sheets("sheet1").printarea="b2:m30" sheets("sheet1").printout 随手写的，你可以试试看。最简单的方法是：你先录制宏，在录制宏过程中，跑到页面设臵里面，把打印范围设臵到你想要的范围。 然后退出，停止录制宏，你就可以得到一些代码！ 002。能否对一列中的文字统一去掉最后一个字?这些文字不统一,有些字数多,有些字数少。如何处理?我用{"&-}不行 解答：=REPLACE(A1,LEN(A1),1," ")(在过渡列进行) 003.能否根据单元格数值自动标记序号？ 各位大佬，一工作表有两列，“序号”及“金额”，能否将金额不等于0的行自动标上序号呢？如无现成的函数，应怎样设臵？ 解答：Dim xuhao As Integer xuhao = 1 Range("b2").Select Do While Selection <> "" If Selection <> 0 Then ActiveCell.Previous.Value = xuhao xuhao = xuhao + 1 End If ActiveCell.Offset(1, 0).Range("a1").Select Loop 004.求教自定义函数 查询了一些自定义函数的例子都是单变量的。自定义函数能否建立“(As Range) As Interger”的函数，应该可以的，请各位大师赐教！请以“∑x2”为例，万分感谢！(该用"For Each ...Next"，就是还不知道如何引用Range中的每个值，请高手指点。) 解答：参数使用Range而函数值为Integer是可以的 用for each next循环思路也是对的，应该这样作： dim rg as range dim ivalue as integer for each rg in 参数区域 ivalue=ivalue+rg.value next 强制声明变量 Option Explicit 说明：该语句必在任何过程之前出现在模块中。 声明常数 用来代替文字值。 Const ' 常数的默认状态是 Private。 Const My = 456 ' 声明 Public 常数。 Public Const MyString = "HELP" ' 声明 Private Integer 常数。 Private Const MyInt As Integer = 5 ' 在同一行里声明多个常数。 Const MyStr = "Hello", MyDouble As Double = 选择当前单元格所在区域 在EXCEL97中，有一个十分好的功能，他就是把鼠标放置在一个有效数据单元格中，执行该段代码，你就可以将连在一起的一片数据全部选中。只要将该段代码加入到你的模块中。Sub My_Select End sub 返回当前单元格中数据删除前后空格后的值 sub my_trim msgbox Trim end sub 单元格位移 sub my_offset (0, 1).Select'当前单元格向左移动一格 (0, -1).Select'当前单元格向右移动一格 (1 , 0).Select'当前单元格向下移动一格 (-1 , 0).Select'当前单元格向上移动一格 end sub 如果上述程序产生错误那是因为单元格不能移动，为了解除上述错误，我们可以往 sub my_offset 之下加一段代码 on error resume next 注意以下代码都不再添加sub “代码名称” 和end sub请自己添加! 给当前单元格赋值 = "你好！！！" 给指定单元格赋值 例如：Ａ１单元格内容设为"ＨＥＬＬＯ" Range("a1").value="hello" 又如：你现在的工作簿在sheet1上，你要往sheet2的Ａ１单元格中插入"ＨＥＬＬＯ" 1. sheets("sheet2").select range("a1").value="hello" 或 2. Sheets("sheet1").Range("a1").Value = "hello" 说明： 被选中，然后在将“HELLO"赋到A1单元格中。 不必被选中，即可“HELLO"赋到sheet2 的A1单元格中。 Excel VBA编程常用代码 时间:2009-12-05 22:36:04 来源:本站作者:未知我要投稿我要收 藏投稿指南 用过VB的人都应该知道如何声明变量，在VBA中声明变量和VB中是完全一样的！使用Dim语句 Dim a as integer '声明a为整型变量 Dim a '声明a为变体变量 Dim a as string '声明a为字符串变量 Dim a as currency ,b as currency ,c as currency '声明a,b,c为货币变量...... 声明变量可以是：Byte、Boolean、Integer、Long、Currency、Single、Double、Decimal（当前不支持）、Date、String（只限变长字符串）、String * length （定长字符串）、Object、Variant、用户定义类型或对象类型。 强制声明变量 Option Explicit 说明：该语句必在任何过程之前出现在模块中。 声明常数 用来代替文字值。 Const ' 常数的默认状态是 Private。 Const My = 456 ' 声明 Public 常数。 Public Const MyString = "HELP" ' 声明 Private Integer 常数。 Private Const MyInt As Integer = 5 ' 在同一行里声明多个常数。 Const MyStr = "Hello", MyDouble As Double = 3.4567 选择当前单元格所在区域 在EXCEL97中，有一个十分好的功能，他就是把鼠标放置在一个有效数据单元格中，执行该段代码，你就可以将连在一起的一片数据全部选中。只要将该段代码加入到你的模块中。 Sub My_Select Selection.CurrentRegion.Select End sub 返回当前单元格中数据删除前后空格后的值 sub my_trim msgbox Trim(ActiveCell.Value) end sub 单元格位移 sub my_offset ActiveCell.Offset(0, 1).Select'当前单元格向左移动一格 多个工作薄合并成同一个工作薄，如何合并？ 多人填一个同样的工作薄，形成了多个工作薄。如何让几人填了一部分的工作薄合并成终稿。 Sub 汇总() Dim mypath As String, myname As String, Dname As String, sh As Workbook, copyrow As Integer Set sh = ThisWorkbook mypath = ThisWorkbook.Path myname = https://www.doczj.com/doc/a85997607.html, Dname = Dir(mypath & "\*.xls") Application.ScreenUpdating = False Do While Dname <> "" If Dname <> myname Then copyrow = 1 With GetObject(mypath & "\" & Dname) For i = 1 To .Worksheets.Count If .Sheets(i).Cells(5, 3) <> "" Then .Sheets(i).Rows("1:" & .Sheets(i).UsedRange.Rows.Count).Copy sh.Sheets(i).Cells(copyrow, 1) End If Next .Close False End With End If Dname = Dir Loop Application.ScreenUpdating = True MsgBox "OK!" End Sub 合并工作簿：将其他工作簿的全部表合并到本工作 Sub 合并工作簿() Dim FilesToOpen Dim x As Integer On Error GoTo ErrHandler Application.ScreenUpdating = False FilesToOpen = Application.GetOpenFilename _ (FileFilter:="Microsoft Excel Files (*.xls), *.xls", _ MultiSelect:=True, Title:="Files to Merge") If TypeName(FilesToOpen) = "Boolean" Then MsgBox "No Files were selected" GoTo ExitHandler End If x = 1 While x <= UBound(FilesToOpen) Workbooks.Open Filename:=FilesToOpen(x) Sheets().Move After:=ThisWorkbook.Sheets _ (ThisWorkbook.Sheets.Count) x = x + 1 Wend ExitHandler: Application.ScreenUpdating = True Exit Sub ErrHandler: MsgBox Err.Description Resume ExitHandler End Sub Sub 合并工作表() For Each st In Worksheets If https://www.doczj.com/doc/a85997607.html, <> https://www.doczj.com/doc/a85997607.html, Then https://www.doczj.com/doc/a85997607.html,edRange.Offset(1, 0).Copy [a65536].End(xlUp).Offset(1, 0) Next End Sub 1.遍历所有已打开的word文档 For Each docOpened In Documents …… Next docOpened 2.Word 将目录下所有文档转换为txt，并删除原文档 Sub 目录下doc转txt() '目录下所有word文档转为txt，并删除word文档 '保存在原目录 '遍历所有文件夹，把带路径的文件名存入字典 On Error Resume Next Dim Path As String, t 'Path为路径,t用于计算程序执行花费的时间 Set objshell = CreateObject("Shell.Application") Set objfolder = objshell.BrowseForFolder(0, "选择文件夹", 0, 0) If Not objfolder Is Nothing Then Path = objfolder.sel f.Path & "\" Set objfolder = Nothing Set objshell = Nothing '创建字典用于存储路径和文件名 Dim DicPath, DicFile, i As Integer, Ke, ContentName A s String, FileName As String, MsgTxt Set DicPath = CreateObject("Scripting.Dictionary") Set DicFile = CreateObject("Scripting.Dictionary") DicPath.Add Path, "" i = 0 '存所有路径 Do While i < DicPath.count Ke = DicPath.keys ContentName = Dir(Ke(i), vbDirectory) Do While ContentName <> "" '若有子文件夹，则添加 '跳过当前的目录及上层目录 If ContentName <> "." And ContentName < > ".." Then If GetAttr(Ke(i) & ContentName) = vbDirectory Then DicPath.Add (Ke(i) & Conte ntName & "\"), "" End If End If ContentName = Dir Loop i = i + 1 Loop '存所有doc文件名 For Each Ke In DicPath.keys FileName = Dir(Ke & "*.doc") EXCEL VBA常用代码集 1.显示活动工作簿名称 MsgBox "当前活动工作簿是" & https://www.doczj.com/doc/a85997607.html, 2.保存活动工作簿 Activeworkbook.Save 3.保存所有打开的工作簿关闭EXCEL For Each W in Application.Workbooks W.Save Next W Application.Quit 4.将网格线设置为蓝色 ActiveWindow.GridlineColorIndex = 5 5.将工作表sheet1隐藏 Sheet1.Visible = xlSheetV eryHidden 6.将工作表Shtte1显示 Sheet1.Visible = xlSheetVisible 7.单击某单元格,该单元格所在的行以蓝色背景填充,字体颜色为白色 Private Sub Worksheet_SelectionChange(ByV al Target As Excel.Range) If Target.Row >= 2 Then’第二行以下的区域 On Error Resume Next [ChangColor_With1].FormatConditions.Delete https://www.doczj.com/doc/a85997607.html, = "ChangColor_With1" With [ChangColor_With1].FormatConditions .Delete .Add xlExpression, , "TRUE" .Item(1).Interior.ColorIndex = 5 .Item(1).Font.ColorIndex = 2 End With End If End Sub 8.使窗体在启动的时候自动最大化 Private Sub UserForm_Initialize() Application.WindowState = xlMaximized With Application Me.Top = .Top Me.Left = .Left Me.Height = .Height Me.Width = .Width End With End Sub 9.不保存工作簿退出EXCEL Application.DisplayAlerts = False Application.Quit Excel 宏编程的常用代码 用过VB的人都应该知道如何声明变量，在VBA中声明变量和VB中是完全一样的！使用Dim语句 Dim a as integer '声明a为整型变量 Dim a '声明a为变体变量 Dim a as string '声明a为字符串变量 Dim a as currency ,b as currency ,c as currency '声明a,b,c为货币变量...... 声明变量可以是：Byte、Boolean、Integer、Long、Currency、Single、Double、Decimal（当前不支持）、Date、String（只限变长字符串）、String * length（定长字符串）、Object、V ariant、用户定义类型或对象类型。 强制声明变量 Option Explicit 说明：该语句必在任何过程之前出现在模块中。 声明常数 用来代替文字值。 Const ' 常数的默认状态是Private。 Const My = 456 ' 声明Public 常数。 Public Const MyString = "HELP" ' 声明Private Integer 常数。 Private Const MyInt As Integer = 5 ' 在同一行里声明多个常数。 Const MyStr = "Hello", MyDouble As Double = 3.4567 选择当前单元格所在区域 在EXCEL97中，有一个十分好的功能，他就是把鼠标放置在一个有效数据单元格中，执行该段代码，你就可以将连在一起的一片数据全部选中。只要将该段代码加入到你的模块中。 Sub My_Select Selection.CurrentRegion.Select End sub VBA编程常用代码 用过VB的人都应该知道如何声明变量，在VBA中声明变量和VB中是完全一样的！使用Dim语句 Dim a as integer '声明a为整型变量 Dim a '声明a为变体变量 Dim a as string '声明a为字符串变量 Dim a as currency ,b as currency ,c as currency '声明a,b,c为货币变量...... 声明变量可以是：Byte、Boolean、Integer、Long、Currency、Single、Double、Decimal（当前不支持）、Date、String（只限变长字符串）、String * length （定长字符串）、Object、Variant、用户定义类型或对象类型。 强制声明变量 Option Explicit 说明：该语句必在任何过程之前出现在模块中。 声明常数 用来代替文字值。 Const ' 常数的默认状态是 Private。 Const My = 456 ' 声明 Public 常数。 Public Const MyString = "HELP" ' 声明 Private Integer 常数。 Private Const MyInt As Integer = 5 ' 在同一行里声明多个常数。 Const MyStr = "Hello", MyDouble As Double = 3.4567 选择当前单元格所在区域 在EXCEL97中，有一个十分好的功能，他就是把鼠标放置在一个有效数据单元格中，执行该段代码，你就可以将连在一起的一片数据全部选中。只要将该段代码加入到你的模块中。 Sub My_Select Selection.CurrentRegion.Select End sub 返回当前单元格中数据删除前后空格后的值 sub my_trim msgbox Trim(ActiveCell.Value) end sub 单元格位移 sub my_offset ActiveCell.Offset(0, 1).Select'当前单元格向左移动一格 ActiveCell.Offset(0, -1).Select'当前单元格向右移动一格 ActiveCell.Offset(1 , 0).Select'当前单元格向下移动一格 ActiveCell.Offset(-1 , 0).Select'当前单元格向上移动一格 Excel VBA常用代码总结1 ?改变背景色 Range("A1").Interior.ColorIndex = xlNone ColorIndex一览 ?改变文字颜色 Range("A1").Font.ColorIndex = 1 ?获取单元格 Cells(1, 2) Range("H7") ?获取围 Range(Cells(2, 3), Cells(4, 5)) Range("a1:c3") '用快捷记号引用单元格 Worksheets("Sheet1").[A1:B5] ?选中某sheet Set NewSheet = Sheets("sheet1") NewSheet.Select ?选中或激活某单元格 '“Range”对象的的Select方法可以选择一个或多个单元格，而Activate方法可以指定某一个单元格为活动单元格。 '下面的代码首先选择A1:E10区域，同时激活D4单元格： Range("a1:e10").Select Range("d4:e5").Activate '而对于下面的代码： Range("a1:e10").Select Range("f11:g15").Activate '由于区域A1:E10和F11:G15没有公共区域，将最终选择F11:G15，并激活F11单元格。 ?获得文档的路径和文件名 ActiveWorkbook.Path '路徑 https://www.doczj.com/doc/a85997607.html, '名稱 ActiveWorkbook.FullName '路徑＋名稱 '或将ActiveWorkbook换成thisworkbook ?隐藏文档 Application.Visible = False ?禁止屏幕更新 Application.ScreenUpdating = False ?禁止显示提示和警告消息 Application.DisplayAlerts = False ?文件夹做成 strPath = "C:\temp\" MkDir strPath ?状态栏文字表示 Application.StatusBar = "计算中" ?双击单元格容变换 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If (Target.Cells.Row >= 5And Target.Cells.Row <= 8) Then If Target.Cells.Value = "●"Then Target.Cells.Value = "" Else Target.Cells.Value = "●" End If Cancel = True End If End Sub ?文件夹选择框方法1 Set objShell = CreateObject("Shell.Application") Set objFolder = objShell.BrowseForFolder(0, "文件", 0, 0) If Not objFolder Is Nothing Then path= objFolder.self.Path & "\" end ifEXCEL常用VBA代码
Excel VBA常用代码总结1
EXCELVBA常用代码实战大全共393页word资料
Excel VBA编程的常用代码
ExcelVBA常用代码VSTO版
excel代码大全
Excel VBA编程的常用代码
Excel VBA 常用代码50例
excelvba编程的常用代码
Excel VBA编程常用代码
Excel-VBA常用技巧代码
VBA常用代码
EXCEL VBA常用代码集
Excel 宏编程的常用代码
VBA常用代码
ExcelVBA常用代码总结1
相关主题
文本预览