Excel VBA 常用代码50例.docx

《Excel VBA 常用代码50例.docx》由会员分享，可在线阅读，更多相关《Excel VBA 常用代码50例.docx（51页珍藏版）》请在三一办公上搜索。

1、Excel VBA 常用代码50例Excel VBA 常用代码50例 001。用命令按扭打印一个sheet1中B2:M30区域中的内容? 我想在Sheet2中制件一个命令按扭, 打印表Sheet1中的B2:M30 区域中的内容? 解答：可以将打印区域设为b2：m30，然后打印，如： sheets(sheet1).printarea=b2:m30 sheets(sheet1).printout 随手写的，你可以试试看。最简单的方法是：你先 录制宏，在录制宏过程中， 跑到页面设臵里面， 把打印范围设臵到你想要的范围。 然后退出，停止录制宏， 你就可以得到一些代码！ 002。能否对一列中的文字统一去

2、掉最后一个字?这些文字不统一,有些字数多,有些字数少。如何处理?我用&-不行 解答：=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 I

3、f 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

4、 in 参数区域 ivalue=ivalue+rg.value next 函数ivalue 大概意思如此，但没有加入防错处理，你自己先试试看，有问题在问。 又问：试了一天，还是不行。 Public Function x2(rng As Range) As Integer Dim rng As Range Dim ivalue As Integer For Each rng In rng.Range ivalue = ivalue + rng.value 2 Next x2 = ivalue End Function 还望您的帮助。 解答：Public Function SUMX2(rng As

5、 Range) As Integer 你的错误有几项： 1.函数名不能使用单元格位址的形式，否则在工作表中引用函数产生歧义，excel以为你引用单元格 2.参数名与内部变量名冲突，rng本来是定义参数，在过程中不应出现重名变量 3.rng已被定义为range对象变量，实际意义是一range引用，不能再用rng.Range引用，range的range属性是什么呢，没有吧 函数我已经给你改了，基本能用 Dim rg As Range Dim ivalue As Integer For Each rg In rng ivalue = ivalue + rg.value 2 Next SUMX2 =

6、ivalue End Function 结果：调试成功！，非常感谢！ 005.判断字符串的包含性 用什么命 令“abcdefg”是否包含“abc”? 解答：If VBA.InStr(1, abcdefg, abc) 0 Then MsgBox 包含 006.利用背景实现套打的解决方案 利用背景套打主要在于数据打印位臵的确定，关键就是要使图片和实物之间的尺寸保持一致，这里我引入一个中间参照物空白表(只有表格线的表)。具体操作以套打支票为例说明： (1)将支票扫描成图片。 (2)打印一个空白表，使其与支票尺寸一致(需反复调整打印，也可行、列分别打印)。 (3)用“画图”的缩放功能调整图片大小，导入

7、excel作背景，并使其与空白表大小一致(亦需反复调整导入，每次均用原图缩放，再另存为一个文件)。 (4)根据图片背景调整好单元格，填入数据后套打支票，效果是匹配度达99%。 (5)由于每次都是用原图缩放，故可取得缩放比例作为参数，再套打其他表格时，即可直接依参数缩放图片。 思路：因为空白表=支票，图片=空白表，所以图片=支票。 该方案已证实可行。 007.宏放在worksheet和sheet及模块中各有什么区别？ 解答：放在this workbook或sheet中的宏与模块中的宏的主要区别是book或sheet中的过程函数只能是对象所专有的，不能在对象之外的任何地方调用，而模块中声明Publ

8、ic过程函数可以在任何地方使用。 008.关于excel问题 在excel中如何用公式实现单元格内容递增？ 如： AB12 AB13 AB14 . AB100 条件是无法确定储存格中的内容的前面有多少个字符，也就是，可能是2个，也可能是3个，或者更多。 解答：為什麼要用公式呢？ 如 A1 = AB12 ，只要你向下拉的複制就可以。 公式可参考 (条件是 AB12 不可以是 AB02， 处理 0 为首的文字 有困难，亦不可以只有英文字) A1 = AB12 A2 = LEFT(A1,LEN(A1)-SUM(LEN(A1)-LEN(SUBSTITUTE(A1,0,1,2,3,4,5,6,7,8,9

9、,) & RIGHT(A1,SUM(LEN(A1)-LEN(SUBSTITUTE(A1,0,1,2,3,4,5,6,7,8,9,)+1 (A1 = AB12 公式 =LEN(SUBSTITUTE(A1,0,1,2,3,4,5,6,7,8,9,) 答案看到的是 4 ，但其實它回傳一個數組 4,3,3,4,4,4,4,4,4,4 公式 =LEN(A1)-LEN(SUBSTITUTE(A1,0,1,2,3,4,5,6,7,8,9,) 答案看到的是 0 ，但其實它回傳一個數組 0,1,1,0,0,0,0,0,0,0 公式 =SUM(LEN(A1)-LEN(SUBSTITUTE(A1,0,1,2,3,4

10、,5,6,7,8,9,) 0,1,1,0,0,0,0,0,0,0 加總 = 2) 009.给数组公式、VBA爱好者泼点冷水。 数组公式、VBA威力巨大，在某些情形下提高效率非常明显，但各有其弱点。数组公式在大数据的时候，运行速度慢得无法忍受。比如，我日常需要编制得几个报表，原始数据有48万行，2030列，用数组根本无法操作。倒是利用数据透视表及其他一些组合功能，可谓神速。而VBA主要适用与日常比较固定的一些工作，对于一些临时性工作而言，缺是將 乏灵活性，有杀鸡用牛刀之嫌疑。因此，根据我个人多年工作经验的体会，能熟练地灵活运用EXCEL基本功能和常用函数，就可以高效地完成大部分日常工作。 我比较

11、常用地东西有：数据透视表，数据有效性，ctrl+enter,index ,match,indirect,offset,if,vlookup,下拉列表框，绝对引用与相对引用，编辑选择性粘贴，图表，条件格式，定义名称，分列，填充等。 相反观点：数据透视表的计算是excel中内臵的，同样的计算次数速度与数组公式是一样的，数组公式计算慢有两个因素，一是公式的编写不合理，另一个主要的原因是数组公式要对所有的引用数据进行计算，不管这些数据是否有效。 VBA应该是最灵活的，在VBA中结合数组公式是可以达到最佳目的的，可用VBA先分析出数组公式要用的有效引用区域，在辅助表中进行数组计算，再将结果记入需要的单元

12、格中，然后删除辅助表。 其实你说的那些基本操作均可用VBA来做的，速度比手工做要快。 010.从式子抽取一小式子的问题？ b1=sum(a1:a10)+(10+20)/4,怎么从中取出(10+20)/4或其结果(即5)？用evaluate、get.cell都不能取出。 解答：定义X=get.formula($B$1)得到B1的公式,再用MID、Right等函数截取 011.or可以用数组应用？ 有一个工作表，数据上万行，其中一列是我要分析的数值，数值比如为：0111，0112，0113，0114，0115，0116，0117中的任何一个。我要统计除0111，0113，0115之外的数据。公式：

13、sum(if(or(sheet!A2:A1111=0111,sheet!a2:a1111=0113,sheet!a2:a1111=0115),1,0),可是统计数字和我筛选相加的不一样，用if层层选，可以。请问原因？ 解答：数组公式中用*、+代替AND、OR sum(if(sheet!A2:A1111=0111)+(sheet!a2:a1111=0113)+(sheet!a2:a1111=0115),1,0) 012.countif表达式的格式 请问：我想找A1：A15中，值不为空的数目，用countif命令怎么写呢？ 解答1：应为counta(a1:a15)。countif为找a1:a15中

14、，特定值的数目。 解答2：=ROWS(A1:A15)*COLUMNS(A1:A15)-COUNTIF(A1:A15,) =ROWS(A1:A15)*COLUMNS(A1:A15)-COUNTBLANK(A1:A15) 解答3：直接用count(a1:a15)不是更好吗! 013.删除字符串中某个字符的函数是什么？删除字符串中某个字符的函数是什么？ 举例：字符串“i love you a!想删除a字面，应该用什么函数实现？还有就是在字符串中某个位臵加入某个字符用什么函数呢？ 解答：如果有一定的规律，可以用Replace函数。例如：在A1单元格已有的字符串”123467中加入个5变为“123456

15、7”。可以这样做：=replace(a1,5,5) 另一方法：用CONCATENATE函数。 例如：a5单元格里的数据是“asdfhjkl,在另外的单元格了输入下面的函数 CONCATENATE(LEFT(A5,4),l,RIGHT(A5,4)，得到的结果就是”asdflhjkl,然后用“选择性粘贴，粘贴数值”粘贴回a5单元格就可以了。 014.两表合一实例 问题提出：怎样把两个表这个程序怎么编写，请高手指点。如果记录增多或字段增多这个程序又应该怎样改写，请高手稍微讲解一下，应为我不是为这一个表，还想用到别的工作表中，谢谢！ 解答：Sub Add_data(sht_Name) 找出要取资料的区

16、域 Dim i As Integer, j As Integer, row_d As Integer Dim First_row As Integer, Last_row As Integer On Error Resume Next With Sheets(总表) i = 1 Do Until .Cells(i, 3).value = sht_Name i = i + 1 Loop First_row = i j = First_row Do Until .Cells(j, 3) sht_Name j = j + 1 Loop Last_row = j - 1 End With Sheets

17、(总表).Range(Cells(First_row, 1), Cells(Last_row, 12).Select Selection.Copy Sheets(sht_Name).Select Range(A2).Select ActiveSheet.Paste With ActiveSheet row_d = .Range(A2).End(xlDown).Row + 1 Range(B & row_d).value = 合计 For i = 5 To 11 Cells(row_d, i).value = Application.WorksheetFunction.Sum(Range(Cel

18、ls(2, i), Cells(row_d - 1, i) Next i End With Sheets(总表).Activate Range(A2).Select End Sub 020.这个公式应该怎么写？ 我想统计所有物料编码的第一个字符为a的库存数量的总和，这个公式应该怎么写？A列为物料编码,B列为库存数量。 解答：=SUMIF($A:$A,a*,$B:$B) 021.样修改此宏？ 下面的宏是k版主帮我写的，从文件夹内汇入其他工作表表格。汇入范围为第五行、第L列。 如汇入范围改为第三行、第R列。 怎样修改此宏？ Public Sub Feed_in2 Dim Row_dn, Row_d

19、n1, i, j, k, m As Integer Dim Path1, Str1 As String Dim wb As Workbook Row_dn = B65536.End(xlUp).Row Path1 = Application.ActiveWorkbook.Path Str1 = ActiveWorkbook.Name k = 5 With Application .EnableEvents = False .ScreenUpdating = False If Row_dn = 5 Then Range(B5:L & Row_dn).ClearContents End If Wi

20、th .FileSearch .NewSearch .LookIn = Path1 .FileType = msoFileTypeExcelWorkbooks If .Execute = 1 Then MsgBox files no found: Exit Sub Else For m = 1 To .FoundFiles.Count Str2 = Split(.FoundFiles(m), ) n1 = UBound(Str2) Str2 = Str2(n1) If Str2 Str1 Then Set wb = Workbooks.Open(Path1 & & Str2), True, T

21、rue) Row_dn1 wb.Sheets(1).B65536.End(xlUp).Row For i = 5 To Row_dn1 = For j = 2 To 12 Workbooks(Str1).Sheets(1).Cells(k, j) _ = wb.Sheets(1).Cells(i, j) Next j k = k + 1 Next i wb.Close False Set wb = Nothing End If Next m End If End With .EnableEvents = True End With End Sub 解答：除了B65536中的5，其余5都改成3；

22、将Range(B5:L & Row_dn)改成Range(B5:R & Row_dn)；将For j = 2 To 12改成For j = 2 To 17。 022.怎样控制textbox的只读，要使textbox中的数据不能改变，在属性里我没有找到 有相关的方法吗？ 解答：Textbox.Enabled = False，直接修改控件属性都行。 又问：这样还不行，因为Textbox在显示上就灰显了，我想只让它不可改变值，在显示上还是原来的形式。 解答：那就用Label代替，设臵BackColor和SpecialEffect属性。 023.请教个小问题！ 你好：我录制了个删除工作表的宏，但每次运

23、行后，总出现确认删除提示框，请问该如何编写，直接默认删除，不在作确认呢？ 解答：Application.DisplayAlerts = False 代码为：Sub Dell Dell Macro DC.Direct 记录的宏 2003-11-14 Application.DisplayAlerts = False Sheets(Sheet2).Select ActiveWindow.SelectedSheets.Delete ActiveWorkbook.Save Application.DisplayAlerts = True End Sub 024.小知识：当垂直滚动条滚动到无法显示1-3

24、行时，冻结窗口，1-3行就好像被隐藏了，但是取消隐藏也不行。 025.选A1后，自动显示B1内容，有无方法实现。有A1列和B1两列，*D1处做了数据-有效性-序列-选择A1A9 *D1选择A1时，要求在G1中自动跳出B1的内容， 选A2时，自动跳出B2的内容*余此类推。 解答：G1公式:=Vlookup(D1,A1:B9,2,0) 又问：假设，有C列中也有数据，我要在G1中显示C列中的数据，该怎么算？ 解答：G1公式:=Vlookup(D1,A1:B9,3,0) 026. 向上填充的快捷键是什么？我只会向下填充的快捷键，向上-向左-向右的都是什么呢？ 解答：向上-Alt+E,I,U。向左-Al

25、t+E,I,L。向右-CTRL+R 027.下方单元格上移，包含该单元格的公式不要变化 哪位高手帮帮忙！我试验了很久也没找到解决的办法： 能不能做到删除单元格以后，下方单元格上移，包含该单元格的公式不要变化。或者是：按住shift拖动单元格，使两个单元格互相交换位臵以后，包含该单元格的公式不要发生变化。注意，用加$的办法是不能解决这个问题的，如公式改为：=SUM($A$1:$A$9),经上述操作后，结果还是一样。 解答：=SUM(INDIRECT(A1:A10) 新问题：但是还有一个问题：我这一列有2000多个数据，似乎不能通过拖动的办法将公式复制200遍，达到每10个1求和的结果。 解答：=

26、IF(MOD(ROW,10)0,SUM(OFFSET(INDIRECT(ADDRESS(ROW,COLUMN,),-1,-10,) 028.一列中删除重复数据的方法 例如在C2:C500中有重复数据。在D2中 =COUNTIF(C2:$C$100,C2) 计算出 C2在此列中的出现次数,然后复制公式到整列,最后删除在D列中大于1的行即可. 029.哪为大侠来帮忙关于VBA的问题 小弟想同时对excel工作簿下的几个工作表进行插入图表的操作！这几个工作表中已经在相同的位臵区域内输入了数据. 语言如下： 运行显示 下表越界 。请问高手又什么办法解决，或者可以用其它的方法。 sub biaoge f

27、or a = 1 to 3 sheets(sheet(a).select charts.add activechart.applycustomtype charttype:=xlbuiltin, typename:=两轴线-柱图 activechart.setsourcedata source:=sheets(sheet (a).range(a1:j3), plotby:=xlrows activechart.location where:=xllocationasobject, name:=sheet(a) activechart.hasdatatable = true activechar

28、t.datatable.showlegendkey = true activechart.legend.select selection.delete next a end sub 解答：sheets(sheet(a).select是错的。可以用sheets(Sheet_Name).select。 029.比较大小 例如512.03,我用函数取了这个数的最后两个数03用他与10比较,结果总是显示0310,不知道是什么原因,请高手指点,谢谢! 解答：取后两位数结果是文本型,对比可用right(a1,2)*110或者用：value(right(a1,2)10也可 030.讨论：用RANGE和CEL

29、LS选择单元格 EXCEL的基本元素就是单元格，第一步就是要学会操作单元格了，列举两种方式。 SUB RANGE 用RANGE选择B5单元格 RANGE(“B5”).SELECT END SUB SUB CELLS 用CELLS选择B5单元格 CELLS(5,2).SELECT END SUB RANGE编程时无法变化，CELLS可以通过变量选择单元格。 回应1：RANGE 一样方便, 甚至更方便. 实际使用中可以用一变量 srArea=B & i RANGE(srArea).SELECT srArea=金额 一命名为 金额 的单元格/区域 RANGE(srArea).SELECT 回应2：我

30、觉得各有长处，如果有变量需要循环判断，用Cells相对比较简单，但是有时候固定区域的，命名后用Range更灵活。 回应3：没错. 帮助中也是推荐 CELL 的. 灵活性来讲, RANGE 要强多了, 而且使用时可以通过 . 提取符快速读取它的属性和方法. 另外, 对于可变更的工作表, 用 RANGE 来操作命名区域将增加程序的弹性. 比如工作中插入一行/列, VBA 中用 CELL 就可能导致运行操作错误, 而 RANGE(srArea) 作为指定区域, 可适应单元格的这类变更. 031.关于FileSystemObject的引用 请问各路高手，有人可以为我指点一下filesystemobje

31、ct引用的详细说明，特别是fileexists方法的实例。 解答：Sub testing 先判断文件是否存在，是则删除之 Dim strmyfile As String strmyfile = d:book1.xls If filetoFind(strmyfile) Then Kill strmyfile End If End Sub Function filetoFind(fileName As String) As Boolean Dim fsobj As Object Set fsobj = CreateObject(Scripting.FileSystemObject) If fsob

32、j.fileexists(fileName) Then filetoFind = True End If End Function 在帮助文件中是这样描述的：FileSystemObject 对象 描述：提供对计算机文件系统的访问。 语法：Scripting.FileSystemObject 说明：下面的代码举例说明了如何使用 FileSystemObject 返回一个 TextStream 对象，该对象是可读并可写的： Set fs = CreateObject(Scripting.FileSystemObject) Set a = fs.CreateTextFile(c:testfile.

33、txt, True) a.WriteLine(This is a test.) a.Close 在上面列出的代码中，CreateObject 函数返回 FileSystemObject (fs)。CreateTextFile 方法接着创建文件作为一个 TextStream 对象(a)，而 WriteLine 方法则向创建的文本文件中写入一行文本。Close 方法刷新缓冲区并关闭文件。 FileExists 方法 描述：如果指定的文件存在，返回 True，若不存在，则返回 False。 语法：object.FileExists(filespec) FileExists 方法语法有如下几部分： 部

34、分 描述：object 必需的。始终是一个 FileSystemObject 的名字。 filespec 必需的。要确定是否存在的文件的名字。如果认为文件不在当前文件夹中，必须提供一个完整的路径说明。 032.excel时间函数2(菜鸟教程) 这一贴说明时间函数，time,hour，minute,second的用法。 time的计算过程： time(hour,minute,second)，time地返回值为0-0.99999999之间的数值，它的计算方法如下： hour的范围：0-24 minute的范围：0-59 second的范围：0-59 在满足以上输入范围的时候：time(hour,m

35、inute,second)=hour/24+minute/(24*60)+second/。如：tiem(05，34,29)=0.232280092592593.如何计算的呢？ 5/24+34/+29/=0.208333333333333+0.0236111111111111 +0.000335648148148148=0.232280092592593。 在帮助文件里还有hour,minute,second不再范围情况，这时候，如何计算的呢？ 1、second/60,除的整数为minute,mod(second,60)为second 2、minute/60，除的整数为hour,mod(minu

36、te,60)为minute 3、hour/24，mod(hour,24)为hour 最后再用hour/24+minute/(24*60)+second/计算。 帮助中的例子：time(0,0,2000)=0.023148如何算的呢？ 2000/60=33 mod(2000,60)=20 time(0,0,2000)=time(0,33,20)=0/24+33/(24*60)=20/(24*60*60)=0.023148 呵呵，其实没有什么用，会用这个函数就可以可，如何算的就不必在意了! 033.年月日的问题 EXCEL表格中年月有时候输入不对，比如198001，意思是XX年1月，可是设臵单元格

37、式日期只有年月日，没有年月。怎么做？ 解答：插入一辅助列，假设198001在E1，F=IF(MID(E1,5,1)=0,LEFT(E1,4)&年&RIGHT(E1,1)&月,LEFT(E1,4)&年&RIGHT(E1,2)&月) 试一下。 又问：198001能否改为1980-1？或者XX年1月改为1980-1？ 解答：f1=IF(MID(e1,5,1)=0,LEFT(e1,4)&-&RIGHT(e1,1),LEFT(e1,4)&-&RIGHT(e1,2) 或者更简单一些：=LEFT(A6,4)&-&value(RIGHT(A6,2) 也可以这样：=date(mid(e1,1,4),mdi(e1

38、,5,2),1)这样会显示为1980-1-1，然后可以随意设臵成相应的日期格式。 034.请帮忙解释一个公式 =LEFT(A1,(SEARCHB(?,A1)-1)/2)这是我在站内过去的帖子里看到的一个公式，用于提取前文后数中的文字部分，非常好用。请教这个公式中最后两步的意义是什么？另外，当A1是“1234个”的格式时，当如何提取其中的文字呢？ 解答：1、公式的含义是：查找第一个半角字符出现的位臵SEARCHB(?,A1)，减去1后除以2，就是文字的字符数目，将其提取出来。 2、=RIGHT(A1,LENB(A1)-LEN(A1) 035.关于宏和程序 我现在已经用excel编了一个较完整的程

39、序，并且能够给源程序加密码，实现工程不可见，但是我发现在vba编辑环境 里还能看到我的大部分宏，虽然说不能编辑，但能运行，请问如何隐藏起来。 解答：不用模块函数,重写成类或放到workbook中,或在程序中直接将菜单宏隐藏。或者：新建类，然后将模块中的程序拷贝到类，提示：找不到宏。 又问：我现在已经能做到屏蔽调alt+F11键了，虽然不能看到我的宏程序，但是依然可以运行我的宏，请高手做答，如何隐藏起我的宏。 解答：在宏的声明前加Private。 036.请教多条件求和的问题 大家好，我是个新手，想向大家请教指定多条件求和的函数公式。 譬如，有一张工作表有4列标题：品名，数量，日期，签收人。 若

40、我想求，符合条件为：品名为A，日期为Y，签收人为B的数量之和。 该用那个函数公式？ 解答：=IF(A2=a,IF(B2=03.10.22,COUNTIF(D:D,D2),时间无),无) A列品名，B列日期，C列数量，D列签收人用if 嵌套。 或者：数组公式 =sum(a1:a100=品名)*(c1:c100=日期)(d1:d100=签收人)*(B1:B100) 也可以：=SUM($A$1:$A$100)=a)*($B$1:$B$100)=03.10.22) 037.请教关于星期的计算？ 如何通过输入一个日期：2003-10-20即可得到该天在本年度的第几个星期？ 解答：使用 WEEKNUM 函

41、数。 如：=WEEKNUM(A1) =WEEKNUM(TODAY) 或者：日期在a1 =INT(A1-DATE(YEAR(A1),1,0)+WEEKDAY(DATE(YEAR(A1),1,0),1)+7-WEEKDAY(A1,1)/7) 也可以用VBA： under the iso standard, a week always begins on a monday, and ends on a sunday. the first week of a year is that week which contains the first thursday of the year, or, equ

42、ivalently, contains jan-4. public function isoweeknum(anydate as date, _ optional whichformat as variant) as integer whichformat: missing or 2 then returns week number, = 2 then yyww dim thisyear as integer dim previousyearstart as date dim thisyearstart as date dim nextyearstart as date dim yearnum as integer thisyear = year(anydate) thisyearstart = yearstart(thisyear) previousyearstart = yearstart(thisyear - 1) nextyearstart = yearstart(thisyear + 1) select case