常用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删除后的工作表区域
升级会员 