常用VBA代码.docx
《常用VBA代码.docx》由会员分享,可在线阅读,更多相关《常用VBA代码.docx(14页珍藏版)》请在冰豆网上搜索。
常用VBA代码
CHAPTER1RANGE对象
合并内容相同的连续单元格
如果需要合并如图156所示的工作表中B列中部门相同的连续单元格,可以使用下面的代码。
图156需合并的工作表
#001SubMergerng()
#002DimIntRowAsInteger
#003DimiAsInteger
#004Application.DisplayAlerts=False
#005WithSheet1
#006IntRow=.Range("A65536").End(xlUp).Row
#007Fori=IntRowTo2Step-1
#008If.Cells(i,2).Value=.Cells(i-1,2).ValueThen
#009.Range(.Cells(i-1,2),.Cells(i,2)).Merge
#010EndIf
#011Next
#012EndWith
#013Application.DisplayAlerts=True
#014EndSub
代码解析:
第7行到第11行代码,从最后一行开始,向上逐个单元格判断连续两个单元格的内容是否相同,如果相同则合并。
运行Mergerng过程后,结果如图157所示。
图157合并内容相同的连续单元格
1-1取消合并单元格时在每个单元格中保留内容
如果需要取消如图157所示的工作表中B列“部门”的合并单元格,并且各个单元格均保留原合并单元格的内容,可以使用下面的代码。
#001SubUnMerge()
#002DimStrMerAsString
#003DimIntCotAsInteger
#004DimiAsInteger
#005WithSheet1
#006Fori=2To.Range("B65536").End(xlUp).Row
#007StrMer=.Cells(i,2).Value
#008IntCot=.Cells(i,2).MergeArea.Count
#009.Cells(i,2).UnMerge
#010.Range(.Cells(i,2),.Cells(i+IntCot-1,2)).Value=StrMer
#011i=i+IntCot-1
#012Next
#013EndWith
#014EndSub
代码解析:
UnMerge过程取消工作表中B列中的合并单元格,并且各个单元格均保留原合并单元格的内容。
第7行代码取得B列每个合并单元格的内容。
第8行代码取得合并区域的单元格数量。
第9行代码使用UnMerge方法取消合并单元格。
UnMerge方法将合并区域分解为独立的单元格,语法如下:
expression.UnMerge
第10行代码将原合并单元格的内容赋值给取消合并单元格后的区域。
第11行代码调整循环变量i的值,使下一次循环从下一个单元格区域开始。
运行UnMerge过程结果如图156所示。
CHAPTER2WORKSHEET对象
遍历工作表的方法
在Excel应用中经常需要遍历工作簿中所有的工作表,有以下两种方法可以实现。
1-2使用For...Next语句
使用For...Next语句遍历工作簿中所有的工作表,如下面的代码所示。
#001SubShCount1()
#002DimcAsInteger
#003DimiAsInteger
#004DimsAsString
#005c=Worksheets.Count
#006Fori=1Toc
#007s=s&Worksheets(i).Name&Chr(13)
#008Next
#009MsgBox"工作簿中含有以下工作表:
"&Chr(13)&s
#010EndSub
代码解析:
ShCount1过程使用For...Next语句遍历工作簿中所有的工作表,并用消息框显示所有的工作表名称。
第5行代码根据Worksheet对象的Count属性返回工作簿中工作表的数量赋给变量c。
应用于Worksheet对象的Count属性返回Worksheets集合中工作表的数量,语法如下:
expression.Count
第6行代码开始For...Next语句循环。
For...Next语句以指定次数来重复执行一组语句,语法如下:
Forcounter=startToend[Stepstep]
[statements]
[ExitFor]
[statements]
Next[counter]
参数counter是必需的,用做循环计数器的数值变量。
参数start是必需的,循环计数器的初值。
参数end是必需的,循环计数器的终值。
参数step是可选的,环计数器的步长,缺省值为1。
参数statements是可选的,放在For和Next之间的一条或多条语句,它们将被执行指定的次数。
第7行代码在For...Next循环中根据工作表的索引号取得所有工作表的名称赋给字符串变量s。
运行ShCount过程结果如图231所示。
图231取得所有工作表名称
技巧2工作表的深度隐藏
在使用VBA开发的工作簿文件完成交与用户使用后,我们往往希望用户在打开工作簿时启用宏,此时除了使用“禁用宏则关闭工作簿”的功能外,还可以隐藏所有有数据的工作表,如果用户在打开工作簿时禁用宏则只显示一张空白的工作表,达到强制启用宏的效果,代码如下:
#001DimshAsWorksheet
#002PrivateSubWorkbook_BeforeClose(CancelAsBoolean)
#003Sheet1.Visible=True
#004ForEachshInThisWorkbook.Sheets
#005Ifsh.Name<>"空白"Then
#006sh.Visible=xlSheetVeryHidden
#007EndIf
#008Next
#009ActiveWorkbook.Save
#010EndSub
#011PrivateSubWorkbook_Open()
#012ForEachshInThisWorkbook.Sheets
#013Ifsh.Name<>"空白"Then
#014sh.Visible=xlSheetVisible
#015EndIf
#016Next
#017Sheet1.Visible=xlSheetVeryHidden
#018EndSub
代码解析:
第2行到第10行代码是工作簿的BeforeClose事件过程,在工作簿关闭前隐藏除“空白”表以外的所有的工作表。
第3行代码将“空白”表的Visible属性设置为True,使其可见。
应用于Charts和Worksheets对象的Visible属性决定对象是否可见,语法如下:
expression.Visible
参数expression是必需的,该表达式返回上面的对象之一。
Visible属性可以设置为表格281所示的XlSheetVisibility常量之一。
常量
值
描述
xlSheetHidden
0
隐藏对象,可以通过“格式”→“工作表”→“取消隐藏”菜单使对象重新可见,等同于设置为False。
xlSheetVisible
-1
使对象重新可见,等同于设置为True。
xlSheetVeryHidden
2
隐藏对象,使该对象重新可见的唯一方法是将此属性设置为True或xlSheetVisible。
表格281XlSheetVisibility常量
第4行到第8行代码使用ForEach...Next语句遍历工作簿中所有的工作表,将除“空白”表以外的所有工作表的Visible属性设置为xlSheetVeryHidden,使之隐藏。
Visible属性设置为xlSheetVeryHidden后工作表不能通过“格式”→“工作表”→“取消隐藏”菜单来显示隐藏的工作表。
第9行代码使用Save方法保存代码所在工作簿的更改,在关闭工作簿时不显示如图281所示的消息框。
图281工作簿保存提示
第10行到第18行代码是工作簿的Open事件过程,在打开工作簿时将除“空白”表以外的所有工作表的Visible属性设置为xlSheetVisible,取消隐藏。
如果打开工作簿时禁用宏,则工作簿中除了“空白”表以外,其他的工作表还处于深度隐藏的状态,如图282所示,这样就达到强制用户启用宏的效果,当然这还需要VBA工程保护的配合。
图282工作表深度隐藏
技巧3工作表中一次插入多行
在工作表的中插入多行空行,需要使用Insert方法,如下面的代码所示。
#001SubInSertRows_1()
#002DimiAsInteger
#003Fori=1To3
#004Sheet1.Rows(3).Insert
#005Next
#006EndSub
代码解析:
InSertRows_1过程使用Insert方法在如图301所示的数据区域的第2行和第3行之间插入三行空行。
图301数据区域
Insert方法应用于Range对象时在工作表或宏表中插入一个单元格或单元格区域,其他单元格作相应移位以腾出空间,语法如下:
expression.Insert(Shift,CopyOrigin)
参数expression是必需的,该表达式返回一个Range对象。
参数Shift是可选的,指定单元格的移动方向。
可为以下XlInsertShiftDirection常量之一:
xlShiftToRight或xlShiftDown。
如果省略本参数,MicrosoftExcel将依据该区域的形状决定移动方向。
参数CopyOrigin是可选的,复制的起点。
还可以使用引用多行的方法,如下面的代码所示。
#001SubInSertRows_2()
#002Sheet2.Range("A3").EntireRow.Resize(3).Insert
#003EndSub
代码解析:
InSertRows_2过程通过引用多行区域的方法实现一次插入多行。
第2行代码中的Range(“A3”).EntireRow属性返回Range(“A3”)单元格所在的一整行,然后使用Resize属性调整行数后插入三行空行。
也可以直接指定相应行再调整行数后插入空行,如下面的示例代码:
#001SubInSertRows_3()
#002Sheet3.Rows(3).Resize(3).Insert
#003EndSub
运行以上过程,工作表中如图302所示。
图302插入三行空行
技巧4删除工作表中的空行
如果需要删除如图311所示的工作表中所有的空行,可以使用下面的代码。
图311需删除空行的工作表区域
#001SubDelBlankRow()
#002DimrRowAsLong
#003DimLRowAsLong
#004DimiAsLong
#005rRow=Sheet1.UsedRange.Row
#006LRow=rRow+Sheet1.UsedRange.Rows.Count-1
#007Fori=LRowTorRowStep-1
#008IfApplication.WorksheetFunction.CountA(Rows(i))=0Then
#009Rows(i).Delete
#010EndIf
#011Next
#012EndSub
代码解析:
DelBlankRow过程删除工作表中已使用的区域的所有空行。
第5行代码获得工作表中已使用区域的首行行号,其中使用UsedRange属性返回工作表中已使用的区域。
第6行代码获得工作表中已使用区域的最后一行行号。
第7行到第11行代码从最大行数至最小行数循环判断指定行是否为空行,若为空行则删除该行。
注意此处一定要从最大行数至最小行数开始循环判断,因为如果工作表中存在两行及两行以上的相邻空行,从最小行数开始循环删除的话,当第一行空行被删除后,被删除行下面的一行会往上移位,而此时For...Next循环的计数器已经加1,所以会出现漏删除的现象。
其中第8、9行代码使用工作表CountA函数判断当前行已使用单元格的数量,如果为零说明此行是空行则使用Delete删除。
应用于Range对象的Delete方法删除对象,语法如下:
expression.Delete(Shift)
参数expression是必需的,返回一个Range对象。
参数Shift是可选的,指定删除单元格时替补单元格的移位方式。
可为以下XlDeleteShiftDirection常量之一:
xlShiftToLeft或xlShiftUp。
如果省略该参数,则MicrosoftExcel将根据区域的图形决定移位方式。
运行DelBlankRow过程工作表区域如图312所示。
图312删除空行的工作表区域
技巧5删除工作表的重复行
在实际应用中,可能需要删除如图321所示的工作表中A列的重复内容而只保留一行,那么可以借助工作表CountIf函数来完成,如下面的代码所示。
图321需删除重复行的工作表区域
#001SubDeleteRow()
#002DimRAsInteger
#003DimiAsInteger
#004WithSheet1
#005R=.[a65536].End(xlUp).Row
#006Fori=RTo1Step-1
#007IfWorksheetFunction.CountIf(.Columns
(1),.Cells(i,1))>1Then
#008.Rows(i).Delete
#009EndIf
#010Next
#011EndWith
#012EndSub
代码解析:
DeleteRow过程删除工作表A列重复单元格所在的整行内容,只保留一行。
第5行代码取得工作表中A列的最后一个非空单元格的行号,关于Range对象的End属性请参阅技巧3。
第6行到第10行代码从最大行数至最小行数循环判断A列单元格内容是否重复并删除重复单元格所在的整行。
和技巧32一样,此处For...Next循环也要从最大行数至最小行数开始循环判断,否则可能会删除不净。
其中第7、8行代码使用工作表CountIf函数判断单元格内容是否重复,如果重复则删除该单元格所在的行。
运行DeleteRow过程工作表区域如图322所示。
图322删除重复行的工作表区域
技巧6定位删除特定内容所在的行
如果需要删除如图331所示的工作表区域中特定内容所在的行,可以使用定位的方法快速删除,无需使用For...Next循环对单元格逐个进行判断。
图331需删除的工作表区域
示例代码如下:
#001SubSpecialDelete()
#002DimRAsInteger
#003WithSheet1
#004R=.Range("a65536").End(xlUp).Row
#005.Range("a2:
a"&R).Replace"Excel","",2
#006.Columns
(1).SpecialCells(4).EntireRow.Delete
#007EndWith
#008EndSub
代码解析:
SpecialDelete过程删除工作表A列单元格中显示为“Excel”的行。
第5行代码使用Replace方法将工作表A列中显示为“Excel”的单元格内容替换成空白。
关于Replace方法请参阅技巧6。
第6行代码使用SpecialCells方法定位到工作表A列中所有的空单元格,使用Range对象的EntireRow属性返回其所在的整个行一次性删除。
关于SpecialCells方法请参阅技巧4。
运行SpecialDelete过程工作表区域如图332所示。
图332删除后的工作表区域