VBA程序集.doc

-1- VBA 程序集(第 1辑)程序 1( 对工作簿的操作)[程序功能]关闭工作簿[情形一]关闭并保存所有工作簿 Option Explicit Sub CloseAllWorkbooks() Dim Book As Workbook For Each Book In Workbooks If <> Then savechanges:=True End If Next Book savechanges:=True End Sub [情形二]关闭工作簿并将它彻底删除 Option Explicit Sub KillMe() With ThisWorkbook .Saved = True .ess Mode:=xlReadOnly Kill .FullName .Close False End With End Sub [程序说明]1、使用本程序时应注意,运行它将彻底删除工作簿。 2、本程序可用于: (1) 工作簿到某时间需删除时; (2) 没有工作簿权限,输入错误的密码时。***************************************************************** 程序 2(对单元格的操作)[程序功能]计算工作表中已使用单元格行列数[方法一] Sub 计算行数()'计算工作表中已使用单元格的行数 Dim rng As Range Dim r as long Set rng = r= End Sub [方法二] Sub 计算行数()'计算工作表中已使用单元格的行数 Dim r as long r= Sheets(1).[a65536].End(xlUp).Row End Sub [程序说明]但此方法只能以一列为基础取行数,当另一列行数比该列行数多时,不能反映已使用的行数。比较后认为,采用方法一较通用。类似地,取列数方法相同。****************************************************** -2- 程序 3( 对列表区域数据的操作—排序) [程序功能]对一列中所选择的数据进行排序,选择列表中选区的任一单元格后,消息对话框显示出该单元格数值在选区中的排序位置。[程序] Option Explicit ‘进行变量声明 Dim MyCell As Range Dim r As Integer Dim MyRange As Range Dim Ans Sub rankalist() Dim m As Integer Set MyRange = Selection On Error Resume Next m= MsgBox "Selection has "&m&" cells.", vbInformation, "Selection Count" Call rankprocess ‘调用子过程 While Ans = vbYes Call rankprocess Wend While Ans = vbNo Exit Sub Wend End Sub Sub rankprocess() Set MyCell = (prompt:="Please select a cell:", Title:="Cell", Type:=8) ‘用输入框返回一个单元格对象给 MyCell 对象变量 If Union(MyCell, MyRange).Address = Then ‘判断单元格是否在选区内 r=1+ - (, MyRange, 0)‘使用 Exce l的 ran k 函数进行排序 Ans = MsgBox(" the present cell is ranked "&r&" in the list "& vbNewLine & "Continue?", vbYesNo) ‘显示排序结果并询问是否继续查看其它单元格排序,还是退出 Else MsgBox "Please select a cell in selection." End If End Sub ******************************************************* 程序 4( 对列表区域数据的操作—排序) [程序功能]在指定列中寻找所包含的字符串,并删