佛山小老鼠说VBA

前言为什么要学VBA？随着你的Excel水平不断的提高，以前你不会函数，现在会函数了，相信大家尝试到函数的甜头，可以批量操作一些数据，如，从文本里提取数字，按条件求和，自动生成工资条，考勤表，查询表，输入一个人的身份证号码，会自动填好“出生地”，“出生年月日”，“年龄”，“性别”等等，一谈起函数大家都会“不亦乐乎”。“津津乐道”，“和函数相见恨晚”，说实在话，我当时也是一种这样的心态，我学会的第一个函数if，当时高兴地睡不着觉。因为它可以判断“不及格，及格，良好，优秀”，感觉到这个函数太神奇了。对工作太有用了，于是我下定决心一定要把函数学好，当然中间也产生过“放弃”的念头。为什么呢？因为每一个函数的参数都是长长的，不认识的英文单词，然后又有一些朋友叫我查看Excel自带的“帮助”文件。极少一部分看“帮助”文件还是可以看懂的，大多数根本看“帮助”文件看不懂，发现自带的“帮助”是便于有一定基础的使用者查找和学习某个知识点，而对于新手来说，也像“侠客行”里的“石破天”看不懂石壁上的蝌蚪文，不能明白其意思。呵呵，一扯又扯远了，还是回到主题上来。当我们的函数学到了一定的水平时，可是，还是发现有一些问题不能解决。如果要解决用的函数特别复杂且很公式很长，有的根本用函数不能解决了。如一个单元格又有文字，又有数字，且数字出现的位置没有规律，且不只一次出现。要求把数字提取出来。又如提取工作薄里的各工作表名来制作目录。当然我们可以用函数实现，但是特别麻烦。又如，把多作工作簿汇总到一个工作簿里一个工作表时，方便我们汇总，现有的Excel功能无法批量操作，只能一个一个的，通过复制粘贴来完成。如果我们会VBA，你又到了Ecel里的另一个天地了。开个玩笑，ExcelVBA，就像“九阴真经”里的第九层，也就是说，你会了Excel的VBA，那么你就可以随心所欲驾驭Excel表格，别人要三天才能完成的报表，你只要半天，甚至更短的时间，这样大大可以提高你的工作效率，上班时，别人上班时忙来忙去，你倒是很轻松。VBA的作用（提高工作效率）完成Excel现有功能不能实现的功能使重复的工作不再重复自定义函数（方便不会用函数的朋友）实现“人机对话”（通过弹出一些窗体和对话框）自定义Excel选项卡（制作出适合自己的工作界面选项卡和功能）开发一些小程序（如“进销存”和一些小工具）学VBA的基础要有一点函数基础，和会Excel基础操作。建议学完办公高级班的学生和在职办公人员学习VBA学VBA需要很好的英文基础吗？答案是否定，学习Excel里的VBA和英文基础没有什么必然联系，因为Excel里的VBA那些关键字什么的都是最基础的英语单词，只要你上过初中，大部分还都能认识，再者他们还都是固定的，你就是不认识，硬记下来也足够了，Excel里的VBA又不是让你用英语写文章，也不是让你通读英语文章！目录第一讲VBA介绍和VBE编辑环境 图26优点：对于刚学习字典的朋友好，可以弹出成员列表出来。缺点：把文件发给别人，别人如果不引用下面这个动态Dll文件就不能用这段代码图SEQ图\*ARABIC26后期绑定要用代码实现方法Setdic=CreateObject("scripting.dictionary")优点：可以发给别人使用，不要担心不能用了缺点：不利用编程人员编辑代码备注：有时可能还是用不了，Windows的开始——>>运行——>>输入Regsvr32Scrrun.D11——>>确定，如果还是失败，那么说明你的电脑没有这个动态库Scrrun.D11，这时你到网上去下载这个，或者你别人的电脑上复制过来这个Scrrun.D11，然后放在C:\WINDOWS\system32文件夹下，再进行上面的注册，Windows的开始——>>运行——>>输入Regsvr32Scrrun.D11——>>确定字典的优势字典可以创建二列的二维数组，更加灵活如果工作表有多列，大家可以用“&”把它们连接起来，再装进字典里字典的一些属性可读可写Key和Item可读可写Keys和Items方法可以转为一维数组，然后再通过转置函数Transpose转为纵向写于单元格字典里Key关键字具有唯一性可以用来去重复值可以用来分类汇总具体我们到后面的实例去了解向字典里装入数据前期绑定的装入见实例Subtest()'这是前期绑定的，方法工具菜单-->>引用-->>浏览-->>选择scrrun.dll-->>打开DimdicAsNewDictionary,arr,arr1,arr2,MaxrowAsLong,iAsLong,xAsLong'定义相关的变量Maxrow=Cells(Rows.Count,1).End(xlUp).Row'取得A列最后有数据的单元格的行号arr=Range("A1:B"&Maxrow)'把区域转为二维数组Fori=1ToUBound(arr,1)'遍历数组arr里一维dic.Addarr(i,1),arr(i,2)'把数组arr里的成员装入字典Nextiarr1=dic.Keys'因为Keys和Items是方法，所以不能写成Keys(1),因此这里要倒一下，绕过圈，dic.Keys先装入数组，然后数组就可以引用了arr2=dic.Items'Forx=1Todic.Count-1'本来是从0开始的，因为dic.Keys和dic.Items得到的数组都是下标从0开始的一维数组，且第一行是表头MsgBoxarr1(x)&"的底薪是"&arr2(x)'通过循环依次显示结果NextxEndSub后期绑定的装入Subtest()'这是后期绑定的DimdicAsObject,arr,arr1,arr2,MaxrowAsLong,iAsLong,xAsLong'定义相关的变量Setdic=CreateObject("scripting.dictionary")Maxrow=Cells(Rows.Count,1).End(xlUp).Row'取得A列最后有数据的单元格的行号arr=Range("A1:B"&Maxrow)'把区域转为二维数组Fori=1ToUBound(arr,1)'遍历数组arr里一维dic.Addarr(i,1),arr(i,2)'把数组arr里的成员装入字典Nextiarr1=dic.Keys'因为Keys和Items是方法，所以不能写成Keys(1),因此这里要倒一下，绕过圈，dic.Keys先装入数组，然后数组就可以引用了arr2=dic.Items'Forx=1Todic.Count-1'本来是从0开始的，因为dic.Keys和dic.Items得到的数组都是下标从0开始的一维数组，且第一行是表头MsgBoxarr1(x)&"的底薪是"&arr2(x)'通过循环依次显示结果NextxEndSub从字典中读中数据实例去重复值Subtest()'没有用防错语句DimdicAsObject'定义变量Setdic=CreateObject("scripting.dictionary")'引用字典Maxrow=Cells(Rows.Count,1).End(xlUp).Row'取得A列最后一个有数据单元格的行号arr=Range("A1:A"&Maxrow)'把单元格区域数据装入二组数组arr里Fori=1ToUBound(arr)'遍因数据arr的一维，相当于遍历单元格区域的行dic(arr(i,1))=""'把数组成员一一加入字典里，Item没有我们就把它等于空，也就是只装了字典的Key'这种表达方，如果有重复就会覆盖，不会报错，如果用Add的方法就要在前面加一句OnerrorresumenextNexti[B1].Resize(dic.Count,1)=Application.WorksheetFunction.Transpose(dic.Keys)''因为dic.keys和dic.items得到都是一维数组，且下标从0开始的，所以要用转置函数EndSubSubtest1()'用防错语句DimdicAsObject'定义变量OnErrorResumeNext'屏蔽添加重复的报错Setdic=CreateObject("scripting.dictionary")'引用字典Maxrow=Cells(Rows.Count,1).End(xlUp).Row'取得A列最后一个有数据单元格的行号arr=Range("A1:A"&Maxrow)'把单元格区域数据装入二组数组arr里Fori=1ToUBound(arr)'遍因数据arr的一维，相当于遍历单元格区域的行dic.Addarr(i,1),""'把数组成员一一加入字典里，Item没有我们就把它等于空，也就是只装了字典的Key'这种表达方，如果有重复就会会报错，就要在前面加一句OnerrorresumenextNexti[B1].Resize(dic.Count,1)=Application.WorksheetFunction.Transpose(dic.Keys)''因为dic.keys和dic.items得到都是一维数组，且下标从0开始的，所以要用转置函数EndSub备注：直接读取用了dic.Keys和dic.Items，如果要循环，那么就要倒传一下，绕过圈，先把dic.Keys和dic.Items赋给数组，也就是装进数组，然后循环数组，因为不能这样引用dic.Keys（0）修改字典里的数据 可以直接用dic("关键字")=“某一个值”，这“某一个值”就是条目对了Subtest()'修改字典里的数据DimdicAsObject,arr,arr1,arr2,MaxrowAsLong,iAsLong,xAsLong'定义相关的变量Setdic=CreateObject("scripting.dictionary")Maxrow=Cells(Rows.Count,1).End(xlUp).Row'取得A列最后有数据的单元格的行号arr=Range("A1:B"&Maxrow)'把区域转为二维数组Fori=1ToUBound(arr,1)'遍历数组arr里一维dic.Addarr(i,1),arr(i,2)'把数组arr里的成员装入字典Nexti'dic("小老鼠")=999'然后我们又把这一句前面加一个逗号去掉让运行看看，发现前面一次1000，去掉逗号之后是999，可以直接用dic("关键字")=“某一个值”，这“某一个值”就是条目对了arr1=dic.Keys'因为Keys和Items是方法，所以不能写成Keys(1),因此这里要倒一下，绕过圈，dic.Keys先装入数组，然后数组就可以引用了arr2=dic.Items'Forx=1Todic.Count-1'本来是从0开始的，因为dic.Keys和dic.Items得到的数组都是下标从0开始的一维数组，且第一行是表头MsgBoxarr1(x)&"的底薪是"&arr2(x)'通过循环依次显示结果NextxEndSub删除字典里的数据删除某一个关键字表达式dic.Remove"关键字"删除全部关键字表达式dic.Removeall Subtest1()'删除字典里的数据DimdicAsObject,arr,arr1,arr2,MaxrowAsLong,iAsLong,xAsLong'定义相关的变量Setdic=CreateObject("scripting.dictionary")Maxrow=Cells(Rows.Count,1).End(xlUp).Row'取得A列最后有数据的单元格的行号arr=Range("A1:B"&Maxrow)'把区域转为二维数组Fori=1ToUBound(arr,1)'遍历数组arr里一维dic.Addarr(i,1),arr(i,2)'把数组arr里的成员装入字典Nexti'dic.Remove"小老鼠"'然后我们又把这一句前面加一个逗号去掉让运行看看，发现前面“小老鼠”这个关键字和对应的条目对没有了'MsgBoxdic.exists("小老鼠")'显示结果为False'dic.RemoveAll'当你把这个前面单引用号去，运行什么也没有了，包括输出函数Msgbox,因为Dic.count=0了arr1=dic.Keys'因为Keys和Items是方法，所以不能写成Keys(1),因此这里要倒一下，绕过圈，dic.Keys先装入数组，然后数组就可以引用了arr2=dic.Items'Forx=1Todic.Count-1'本来是从0开始的，因为dic.Keys和dic.Items得到的数组都是下标从0开始的一维数组，且第一行是表头MsgBoxarr1(x)&"的底薪是"&arr2(x)'通过循环依次显示结果NextxEndSub判断某一“关键字”是否存在，用dic.exists("关键字")第十六讲字典实例应用（二）利用字典里的关键词的唯一性，在添加关键词把条目对的值也同时添加为1，2，4，4，5……，这样就把数组里的重复值名字去掉了，且数组里的索引号和字典里的条目对是一致的，且把数值累加，起到了分类汇总的作用。实例一：多列汇总，按A列的产品名称，把B列的数和C列的金额汇总Subtest()'定义相关的变量Dimarr(1To10000,1To3),arr1,dicAsObject,iAsLong,kAsLong,hangAsLong,MaxrowAsLong,tAsSinglet=Timer'开始记时Maxrow=Cells(Rows.Count,1).End(xlUp).Row'找到A列最后一个有数据单元格的行号Setdic=CreateObject("scripting.dictionary")'创建字典arr1=Range("A2:C"&Maxrow)'把单元格区域装入数组Fori=1ToUBound(arr1,1)'遍历数组arr1的一维Ifdic.exists(arr1(i,1))Then'如果字典里存在arr1这个关键词，那么hang=dic(arr1(i,1))'找到这个关键词在字典里的位置，对应的Item,而字典里这种Item位置刚好和数组arr的一维对应arr(hang,2)=arr(hang,2)+arr1(i,2)'累加数组arr前面所对应的数量arr(hang,3)=arr(hang,3)+arr1(i,3)'累加数组arr前面所对应的金额Elsek=k+1'累加kdic(arr1(i,1))=k'把关键字arr1（i,1)添加到字典里，且条目对为karr(k,1)=arr1(i,1)'把数组arr1里的第i行第1列的数据装进一个新的arr数组里的第k行第1列arr(k,2)=arr1(i,2)''把数组arr1里的第i行第2列的数据装进一个新的arr数组里的第k行第2列arr(k,3)=arr1(i,3)''把数组arr1里的第i行第3列的数据装进一个新的arr数组里的第k行第3列EndIfNexti[E1:G1]=Array("产品名称","数量","金额")'Range("E2").Resize(k,3)=arrMsgBox"用时"&Format(Timer-t,"0.00秒")'EndSub实例2按照A列的产品称和B列的型号对C列和D列的数据进行汇总Subtest()'定义相关的变量Dimarr(1To10000,1To4),arr1,dicAsObject,iAsLong,kAsLong,hangAsLong,MaxrowAsLong,tAsSinglet=Timer'开始记时Maxrow=Cells(Rows.Count,1).End(xlUp).Row'找到A列最后一个有数据单元格的行号Setdic=CreateObject("scripting.dictionary")'创建字典arr1=Range("A2:D"&Maxrow)'把单元格区域装入数组Fori=1ToUBound(arr1,1)'遍历数组arr1的一维Mystring=arr1(i,1)&arr1(i,2)'把两个合起来为一个，因为字典的关键词只能装进一列Ifdic.Exists(Mystring)Then'如果字典里存在arr1这个关键词，那么hang=dic(Mystring)'找到这个关键词在字典里的位置，对应的Item,而字典里这种Item位置刚好和数组arr的一维对应'把字典里的相应的关键键对应的条目对值赋给hangarr(hang,3)=arr(hang,3)+arr1(i,3)'累加数组arr前面所对应的数量arr(hang,4)=arr(hang,4)+arr1(i,4)'累加数组arr前面所对应的金额Elsek=k+1'累加kdic(Mystring)=k'把关键字Mystring添加到字典里，且条目对为karr(k,1)=arr1(i,1)'把数组arr1里的第i行第1列的数据装进一个新的arr数组里的第k行第1列arr(k,2)=arr1(i,2)''把数组arr1里的第i行第2列的数据装进一个新的arr数组里的第k行第2列arr(k,3)=arr1(i,3)''把数组arr1里的第i行第3列的数据装进一个新的arr数组里的第k行第3列arr(k,4)=arr1(i,4)''把数组arr1里的第i行第4列的数据装进一个新的arr数组里的第k行第4列EndIfNexti[E1:H1]=Array("产品名称","型号","数量","金额")'Range("E2").Resize(k,4)=arrMsgBox"用时"&Format(Timer-t,"0.00秒")'EndSub

第十七讲自定义右键菜单有时为了工作上的方便，我们要经常用某一个功能，因此我们把这个功能放到右键上，放到上面也可以自己编程的功能，也可以内置的功能实例代码Sub添加右键菜单()'过程的名称,Sub是开始的意思DimcdAsCommandBarButton'定义变量'Dim定义变量的意思,As象什么,CommandBarButton是按钮的意思OnErrorResumeNext'为了防止没有添加就删除会报错Application.CommandBars("cell").Controls("签名").Delete'删除右键"签名"按钮Application.CommandBars("cell").Controls("日期").Delete'删除右键"日期"按钮Setcd=Application.CommandBars("cell").Controls.Add(Type:=msoControlButton,before:=1)'set是给的意思,赋值的意思;appication是EXCEL程序的意思;CommandBars是菜单的意思;Cell是右键菜单的意思;'Controls是指右键菜单上的按钮集合;Add是添加的意思;Type是类型的意思;msoControlButton是按钮型;Before:在什么的前面的意思Withcd'cd相当于我们说话的主语了,后面的语句就可以省略这个主语.Caption="签名"'Caption是指这个按钮在右键菜单上的名字'.FaceId=483'FaceId是指图标.OnAction="签字"'OnAction是指这个按钮关联的过程和动作'EndWithSetce=Application.CommandBars("cell").Controls.Add(Type:=msoControlButton,before:=2)'set是给的意思,赋值的意思;appication是EXCEL程序的意思;CommandBars是菜单的意思;Cell是右键菜单的意思;'Controls是指右键菜单上的按钮集合;Add是添加的意思;Type是类型的意思;msoControlButton是按钮型;Before:在什么的前面的意思Withce'cd相当于我们说话的主语了,后面的语句就可以省略这个主语.Caption="日期"'Caption是指这个按钮在右键菜单上的名字'.FaceId=484'FaceId是指图标.OnAction="日期"'OnAction是指这个按钮关联的过程和动作'EndWithEndSub'结束过程end是结束意思Sub签字()Selection="老鼠"EndSubSub恢复右键菜单()Application.CommandBars("cell").ResetEndSubSub日期()Selection=DateColumns.AutoFitEndSub上面是普通模块里的代码，下面是工作簿模块里的代码PrivateSubWorkbook_BeforeClose(CancelAsBoolean)Application.CommandBars("cell").Controls("签名").DeleteApplication.CommandBars("cell").Controls("日期").DeleteEndSubPrivateSubWorkbook_Open()添加右键菜单EndSub第十八讲自定义选项卡开发一个适合自己工作的或者适合某一部分的选项卡，方便自己和他人，如老师开发的“完美工具箱”，下面我们就来讲一下自定义选项卡的方法第一步：在桌面上创建一个名为customUI的文件夹第二步：打开记事本，把下面的XML代码复制到记事本里：文件名为CustomUI.xml,编码为UTF-8保存到桌面customUI文件夹中<customUIxmlns="/office/2006/01/customui"><ribbonstartFromScratch="false"><tabs><tabid="rxtabCustom"label="我的工具箱"insertBeforeMso="TabHome"><groupid="mygroupB"label="自己开发的"> <buttonid="a1"imageMso="PictureStylesGallery"size="large"label="我的签名"onAction="名字"/></group><groupid="mygroupD"label="VBA开发"> <controlidMso="VisualBasic"label="VBE编辑器"/> <controlidMso="MacroRecord"label="录制新宏"/> <controlidMso="ControlsGallery"label="窗体与控件"/></group></tab></tabs></ribbon></customUI>备注：如果选项卡要放在开始选卡的前面就用这一句,把它放在加载项的后面insertAfterMso="TabAddIns">第三步：在桌面上新建一个启用宏的Excel文件，并命名为MyCustomUI.xlsm，因为在自定义的XML中，包含了产生回调的onAction属性，所以创建的Excel文件需要启用宏。第四步：在MyCustomUI.xlsm中，按Alt+F11组合键打开VBE，并插入一个标准模块，添加下面的代码供回调使用第五步：在MyCustomUI.xlsm中，按Alt+F11组合键打开VBE，并插入一个标准模块，添加下面的代码供回调使用Sub名字(controlAsIRibbonControl)Selection="老鼠"EndSub第六步：在MyCustomUI.xlsm图标上单击右键，选择“重命名”，在文件名后添加“.zip”扩展名，使其变为一个压缩文件第七步：双击该压缩文件，打开压缩包，将customUI文件夹拖到该压缩包中第八步：将压缩包中的_rels文件夹拖至桌面。第九步：打开桌面中的_rels文件夹，然后用记事本打开