EXCEL常用VBA代码.doc

《EXCEL常用VBA代码.doc》由会员分享，可在线阅读，更多相关《EXCEL常用VBA代码.doc（8页珍藏版）》请在淘文阁 - 分享文档赚钱的网站上搜索。

1、删除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 NextEnd Sub -【工作表合并】将同一工作簿中的所有工作表合并到一个工作表中新建一个工作表，写入代码在新建的工作表标签处右键 查看代码（找不到的直接按一下alt+F11) 把下面 的代码复制进去 然后点上面的运行 运行子程序即可：Sub 合并当前工作簿下的所有工作表()Application.ScreenUpd

2、ating = FalseFor j = 1 To Sheets.Count If Sheets(j).Name ActiveSheet.Name Then X = Range(A65536).End(xlUp).Row + 1 Sheets(j).UsedRange.Copy Cells(X, 1) End IfNextRange(B1).SelectApplication.ScreenUpdating = TrueMsgBox 当前工作簿下的全部工作表已经合并完毕！, vbInformation, 提示End Sub*代码这样写也行：Sub c()For i = Sheets.Count

3、To 2 Step -1Sheets(i).SelectSheets(i).UsedRange.CopySheets(1).SelectCells(Cells(65000, 1).End(xlUp).Row + 1, 1).SelectActiveSheet.PasteSheets(i).DeleteNext iEnd Sub*把一个工作簿中的所有表单合并成一个表单，怎么去掉重复的表头、标题行？方法如下：Sub c()For i = Sheets.Count To 2 Step -1Sheets(i).UsedRange.Offset(1).Copy Sheets(1).Cells(65536

4、, 1).End(xlUp).Offset(1)Next iEnd Sub说明：函数OFFSET(reference,rows,cols,height,width)以指定的引用为参照系，通过给定偏移量得到新的引用。返回的引用可以为一个单元格或单元格区域。并可以指定返回的行数或列数。通俗的讲就是OFFSET(参考单元格，移动的行数，移动的列数，所要引用的行数，所要引用的列数） 参考关于offset函数第三行中第一个offset(1)是假设要要去掉的表头行数，如果有2行表头，就改成offset(2)，要去掉几行表头括号中的数字就改成几。第二个offset(1)表示合并以后表格与表格之间要间隔的空行

5、，offset(1)表示不留空行，offset(2)表示间隔1行空行，以此类推。也可以这样写：Sub c()For i = Sheets.Count To 2 Step -1Sheets(i).UsedRange.Offset(2).Copy Sheets(1).Cells(Cells(65536, 1).End(xlUp).Row + 1, 1).Offset(0) 这个offset(0)可以不要Next iEnd Sub*或者用以下宏代码将同一工作簿中的所有工作表合并到一个新建的工作表中按ALT+F11调出窗口，插入一个模块，然后把下面的代码复制进去。Sub hz() Set NewShe

6、et = Sheets.Add(Type:=xlWorksheet) 生成一个新表 Sheets(NewSheet.Index).Move Before:=Sheets(1) 将此新表移动到最前面 For i = 2 To Worksheets.Count Sheets(i).UsedRange.Copy NewSheet.Cells(a65536.End(xlUp).Row + 2, 1) 将其他表的已使用区域复制到新表中 Next i MsgBox 合并完成End Sub这段代码很简单，其中第四行中用FOR循环得到当前工作簿中的所有工作表，第五行中使用UsedRange得到每个工作表的“已

7、使用区域”，然后用copy方法把这些“已使用区域”中的内容复制到新建工作表中。语句Cells(a65536.End(xlUp).Row + 2, 1)的作用是得到新建工作表的列中的最后空白单元格(即要在哪个位置粘贴)，加2的作用是使每次复制数据间隔2行空格（此处应表示间隔1行空格，加1的话，表示合并的表格与表格之间不留空格）。回到EXCEL窗口，执行“工具-宏-宏”中的“hz”宏就会自动合并工作表了。（经本人测试，不能使用右键点击标签查看代码再粘入代码的方式，应该运用菜单栏插入模块的方式）-【工作簿合并】将需要合并的工作簿文件放置在一个文件夹中，并新建一个工作簿，写入代码：Sub 合并工作薄(

8、)Dim FilesToOpenDim x As IntegerOn Error GoTo ErrHandlerApplication.ScreenUpdating = FalseFilesToOpen = Application.GetOpenFilename _(FileFilter:=MicroSoft Excel文件(*.xls), *.xls, _MultiSelect:=True, Title:=要合并的文件)If TypeName(FilesToOpen) = Boolean ThenMsgBox 没有选中文件GoTo ExitHandlerEnd Ifx = 1While x

9、= UBound(FilesToOpen)Workbooks.Open Filename:=FilesToOpen(x)Sheets().Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)x = x + 1WendExitHandler:Application.ScreenUpdating = TrueExit SubErrHandler:MsgBox Err.DescriptionResume ExitHandlerEnd Sub-显示隐藏的工作表Sub ShowAllSheets() 使当前工作簿中的所有工作表都显示(即将隐

10、藏的工作表也显示) Dim ws As Worksheet For Each ws In Sheets ws.Visible = True Next wsEnd Sub-根据Sheet2中的数据，检查Sheet1中的重复数据，并且进行后续的操作（将重复数据删除或者拷贝出来）的操作。Application.ScreenUpdating = False C = 2 第一个工作表检测B列 X = 1 第一条检测结果放在第1行 Count = 1 First_sheet_row = Sheets(1).Cells(65536, C).End(xlUp).Row Second_sheet_row = S

11、heets(2).Cells(65536, C).End(xlUp).Row Dim To_be_deleted(5369) As String For j = 1 To 5368 To_be_deleted(j) = Trim(CStr(Sheets(2).Cells(j, 2).Value) Next j For i = 1 To First_sheet_row First_value = Trim(CStr(Sheets(1).Cells(i, C).Value) For j = 1 To 5368 MsgBox To_be_deleted(j) If First_value = To_

12、be_deleted(j) Then Sheets(1).Range(A & CStr(i) & :Ag & i).Delete Sheets(2).Cells(j, 4).Value = Copied Sheets(2).Cells(j, 3).Value = Copied Application.CutCopyMode = False Sheets(1).Range(A & CStr(i) & :Ag & i).Copy Sheets(3).Paste Destination:=Sheets(3).Range(A & i) Sheets(3).Paste Count = Count + 1

13、 i = i - 1 End If Next j Next i Application.ScreenUpdating = True MsgBox 共删除了 & Count这个脚本中有一些优化的地方，原来进行数据比较时，都是使用直接Cell(x,y)的方式访问并对比，另外也是分别循环，效率非常低，Excel一直处于假死的状态。后来，先将比较小的一份数据拷贝到数组中，然后再进行循环，这样效率就提高了很多。-合并目录中具有同样数据格式的多个Excel文件Dim MyPath, MyName, AWbName Dim Wb As Workbook, WbN As String Dim G As Lon

14、g Dim Num As Long Dim BOX As String Application.ScreenUpdating = False MyPath = ActiveWorkbook.Path MyName = Dir(MyPath & & *.xls) AWbName = ActiveWorkbook.Name Num = 0 Do While MyName If MyName AWbName Then Set Wb = Workbooks.Open(MyPath & & MyName) Num = Num + 1 With Workbooks(1).ActiveSheet .Cell

15、s(.Range(A65536).End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4) For G = 1 To Sheets.Count Wb.Sheets(G).UsedRange.Copy .Cells(.Range(A65536).End(xlUp).Row + 1, 1) Next WbN = WbN & Chr(13) & Wb.Name Wb.Close False End With End If MyName = Dir Loop Range(A1).Select Application.ScreenUpdating = T

16、rue MsgBox 共合并了 & Num & 个工作薄下的全部工作表。如下： & Chr(13) & WbN, vbInformation, 提示 -奇偶页分别打印 Sub 奇偶页分别打印() Dim i%, Ps% Ps = ExecuteExcel4Macro(“GET.DOCUMENT(50)”) 总页数 MsgBox “现在打印奇数页,按确定开始.” For i = 1 To Ps Step 2 ActiveSheet.PrintOut from:=i, To:=i Next i MsgBox “现在打印偶数页,按确定开始.” For i = 2 To Ps Step 2 Activ

17、eSheet.PrintOut from:=i, To:=i Next i End Sub -将A列最后数据行以上的所有B列图片大小调整为所在单元大小 Sub 将A列最后数据行以上的所有B列图片大小调整为所在单元大小() Dim Pic As Picture, i& i = A65536.End(xlUp).Row For Each Pic In Sheet1.Pictures If Not Application.Intersect(Pic.TopLeftCell, Range(“B1:B” & i) Is Nothing Then Pic.Top = Pic.TopLeftCell.Top

18、 Pic.Left = Pic.TopLeftCell.Left Pic.Height = Pic.TopLeftCell.Height Pic.Width = Pic.TopLeftCell.Width End If Next End Sub 如何在原有行高的基础上增加一个固定值 Private Sub CommandButton1_Click() Dim i, HangGao Rows(1:100).EntireRow.AutoFit HangGao = InputBox(已设定自适应行高，设定想增加的行高, 增加行高) Application.ScreenUpdating = False

19、 For i = 1 To 100 Rows(i).RowHeight = Rows(i).RowHeight + CVar(HangGao) Next i Application.ScreenUpdating = TrueEnd Sub代码的意思是：选中前100行，然后自动根据内容调整到合适的行高，就跟你选中以后双击黑线是一样的效果。然后在弹出的对话框中输入你想要每行增加行高的数值，比如说输入23，每个行高就加23.-其他解释：Range是区域，范围的意思range(A1)对一个单元格集合进行范围筛选(只选中最左上角的1个单元格)，比如 sheet1.range(A1:C3).select将

20、选中sheet1的左上角的9个单元格选中。1、Range 属性Range(arg)（其中 arg 为区域名称）来返回代表单个单元格或单元格区域的 Range 对象 2、Cells 属性可用 Cells(row,column）（其中 row 为行号，column 为列标）返回单个单元格3、Range 和 Cells可用 Range(cell1,cell2） 返回一个 Range 对象，其中 cell1 和 cell2 为指定起始和终止位置的 Range 对象。下例设置单元格区域 A1:J10 的边框线条的样式。With Worksheets.Range(.Cells（1,1），.Cells（10

21、,10）.Borders.LineStyle = xlThickEnd With注意每个 Cells 属性之前的句点。如果前导的 With 语句应用于该 Cells 属性，那么这些句点就是必需的。本示例中，句点指示单元格处于第一张工作表上。如果没有句点，Cells 属性将返回活动工作表上的单元格。4、Offset 属性可用 Offset(row,column）（其中 row 和 column 为行偏移量和列偏移量）返回相对于另一区域在指定偏移量处的区域。下例选定位于当前选定区域左上角单元格的向下三行且向右一列处的单元格。由于必须选定位于活动工作表上的单元格，因此必须先激活工作表。5、Union

22、 方法可用 Union(range1,range2,.) 返回多块区域，即该区域由两个或多个连续的单元格区域所组成。下例创建由单元格区域 A1:B2 和 C3:D4 组合定义的对象，然后选定该定义区域。6、在VBA操作工作簿工作表时,会有很多刷新屏幕的动作,以致代码执行速度受到影响,Application.ScreenUpdating = False可以屏蔽屏幕刷新,进而提高运行速度，不过别忘了,在程序结尾添加恢复代码,即:Application.ScreenUpdating = TRUESheets(j).Name-表（J）名称 ActiveSheet.Name-活动表的名称）8称的表 ）

23、- . = . ,复尾程了忘度速而进幕以 ,到度执以作的新有时作作 域域定然象义 : 域格建下组域单续个由该，块回. , 方 表表激此格的上动于必。元处右行的格左域选于例域量移域区对）偏列偏 中 ( 属 格元上动返将 句有。工一格示句例示必就些么 用句 导。点之 个 .0, .）（ . 式样条 区单设象 止终指 中象 一 ( 和 元个返列为 为 中（ ( 属 象 域单格单表返域区 中) 属 中中元的的 将 : )单的上中选围行格个 意围域 释- 加行每入说比高行要想输的在然果一是双中就高合整内动然0前：思 . ) . 0 = 高增 的想，行定( )0:( ( 定一增基高何 / / . . .

24、. . = = . ) . . ) . & )小大为小图有所据最将小元在调大 有行后- : : . ”开页数在 : : . =”定页印现“数数)( % % )(别页打别-示 , &。作的作& 共 & & ) . . ( . ) =) ) ( , ) ) ) = 0 = ) & ( . , , 文 多格同具-多很提效这循再，数数的较，。态于一 非，循分，对式) 接用，较数原地化一中 &了删 = . - + ) ) : )( . &( & ) .,( . , ) ) ) _ ) _ = ) . )( ( ) . ( ( =) _ ), ( = _ . = _ 行第放检第 列测作一 = 作的出者删数

25、（的行进，重 检数 - = 显工藏即都作所作当 作作- . = = . : . : 件文没 文合= ).件 = (作工码入簿工新中文个放作的并合-式式入栏菜应方入码看标键使试人了表合会”“”宏工执口 ）空不表与合， ，空示应格 间复每用加)位在(元后最的作新是) + . 中作建制内域区“法 用，”已表个得 中第，所簿前到 用四其单码 成并 表到制用表将 ,+ ) (. . 前到表此)( 新个 : = ( 去去代下后块入口调 表表建到合作的工代代* 不以( 0 ),+ . . ( . - = ( 写这可。，空 表 空不( ，隔要与后合) 个第成字号表几去( 就表 ，头的要设) 第数 的要，用引列的数移，考 就俗。数回指并。单格一以的。的新偏给，参的定 , , , 函 . 列 )符, (值 . )元 所 的 = (下法行题表掉怎，个单所簿工* . .除 ( ), .( . . .( - ( ) 行)行* * *.* * *行* 示 ,完经作全簿前 , . . . = = (作所簿工合 即子行运点然制码 把) 按直（看键签表建代表工表工个表有的工将并- - =