《VBA程序开发-259个常用宏.xls》由会员分享，可在线阅读，更多相关《VBA程序开发-259个常用宏.xls（152页珍藏版）》请在taowenge.com淘文阁网|工程机械CAD图纸|机械工程制图|CAD装配图下载|SolidWorks_CaTia_CAD_UG_PROE_设计图分享下载上搜索。
1、代代码码目目录录链链接接类类别别打开全部隐藏工作表点击工作表循循环环宏宏点击宏管理录录制制宏宏时时调调用用“停停止止录录制制”工工具具栏栏点击其他高高级级筛筛选选5 5列列不不重重复复数数据据至至指指定定表表点击筛选双双击击单单元元执执行行宏宏(工工作作表表代代码码)点击宏管理双双击击指指定定区区域域单单元元执执行行宏宏(工工作作表表代代码码)点击宏管理进进入入单单元元执执行行宏宏(工工作作表表代代码码)点击宏管理进进入入指指定定区区域域单单元元执执行行宏宏(工工作作表表代代码码)点击宏管理在在多多个个宏宏中中依依次次循循环环执执行行一一个个（控控件件按按钮钮代代码码）点击宏管理在在两两个个宏
2、宏中中依依次次循循环环执执行行一一个个并并相相应应修修改改按按钮钮名名称称（控控件件按按钮钮代代码码）点击宏管理在在三三个个宏宏中中依依次次循循环环执执行行一一个个并并相相应应修修改改按按钮钮名名称称（控控件件按按钮钮代代码码）点击宏管理根根据据A1A1单单元元文文本本隐隐藏藏/显显示示按按钮钮（控控件件按按钮钮代代码码）点击控件当当前前单单元元返返回回按按钮钮名名称称（控控件件按按钮钮代代码码）点击控件当当前前单单元元内内容容返返回回到到按按钮钮名名称称（控控件件按按钮钮代代码码）点击控件奇奇偶偶页页分分别别打打印印点击打印自自动动打打印印多多工工作作表表第第一一页页点击打印查查找找A A列
3、列文文本本循循环环插插入入分分页页符符点击打印将将A A列列最最后后数数据据行行以以上上的的所所有有B B列列图图片片大大小小调调整整为为所所在在单单元元大大小小点击对象返返回回光光标标所所在在行行数数点击查找和引用在在A1A1返返回回当当前前选选中中单单元元格格数数量量点击查找和引用返返回回当当前前工工作作簿簿中中工工作作表表数数量量点击查找和引用返返回回光光标标选选择择区区域域的的行行数数和和列列数数点击查找和引用工工作作表表中中包包含含数数据据的的最最大大行行数数点击查找和引用返返回回A A列列数数据据的的最最大大行行数数点击查找和引用将所选区域文本插入新建文本框点击对象批量插入地址批注
4、点击批注批量插入统一批注点击批注以A1单元内容批量插入批注点击批注不连续区域插入当前文件名和表名及地址点击单元赋值不连续区域录入当前单元地址点击单元赋值连续区域录入当前单元地址点击单元赋值返回当前单元地址点击单元赋值不连续区域录入当前日期点击单元赋值不连续区域录入当前数字日期点击单元赋值不连续区域录入当前日期和时间点击单元赋值不连续区域录入对勾点击单元赋值不连续区域录入当前文件名点击单元赋值不连续区域添加文本点击单元赋值不连续区域插入文本点击单元赋值从指定位置向下同时录入多单元指定内容点击单元赋值按aa工作表A列的内容排列工作表标签顺序点击工作表登登录录以A1单元文本作表名插入工作表点击工作表
5、删除全部未选定工作表点击工作表工作表标签排序点击工作表定义指定工作表标签颜色点击工作表在目录表建立本工作簿中各表链接目录点击文件管理建立工作表文本目录点击工作表查另一文件的全部表名点击工作表当前单元录入计算机名点击单元赋值当前单元录入计算机用户名点击单元赋值解除全部工作表保护点击工作表为指定工作表加指定密码保护表点击密码在有密码的工作表执行代码点击密码执行前需要验证密码的宏(控件按钮代码)点击密码拷拷贝贝A1A1公公式式和和格格式式到到A2A2点击单元赋值复复制制单单元元数数值值点击单元赋值插入数值条件格式点击格式插入透明批注点击批注添加文本点击单元赋值光光标标定定位位到到指指定定工工作作表表
6、A A列列最最后后数数据据行行下下一一单单元元点击定位定定位位选选定定单单元元格格式式相相同同的的全全部部单单元元格格点击定位按按当当前前单单元元文文本本定定位位点击定位按按固固定定文文本本定定位位点击定位删删除除包包含含固固定定文文本本单单元元的的行行或或列列点击定位定定位位数数据据及及区区域域以以上上的的空空值值点击定位右右侧侧单单元元自自动动加加5(5(工工作作表表代代码码)点击单元赋值当当前前单单元元加加2 2点击单元赋值A A列列等等于于A A列列减减B B列列点击单元赋值用用于于光光标标选选定定多多区区域域跳跳转转指指定定单单元元(工工作作表表代代码码)点击定位将A1单元录入的数据
7、累加到B1单元（工作表代码）点击单元赋值在指定颜色区域选择单元时添加/取消（工作表代码）点击单元赋值在指定区域选择单元时添加/取消（工作表代码）点击单元赋值双击指定单元，循环录入文本（工作表代码）点击单元赋值单元区域引用（工作表代码）点击单元赋值在指定区域选择单元时数值加1（工作表代码）点击单元赋值混合文本的编号点击单元赋值指定区域单元双击数据累加（工作表代码）点击单元赋值选择单元区域触发事件（工作表代码）点击事件当修改指定单元内容时自动执行宏（工作表代码）点击事件被指定单元内容限制执行宏点击事件双击单元隐藏该行（工作表代码）点击事件高亮显示行（工作表代码）点击其他高亮显示行和列（工作表代码）
8、点击其他为指定工作表设置滚动范围（工作簿代码）点击定位在指定单元记录打印和预览次数（工作簿代码）点击打印自动数字金额转大写（工作表代码）点击单元赋值将全部工作表的A1单元作为单击按钮（工作簿代码）点击对象闹闹钟钟到指定时间执行宏（工作簿代码）点击事件改变Excel界面标题的宏（工作簿代码）点击其他在在指指定定工工作作表表的的指指定定单单元元返返回回光光标标当当前前多多选选区区地地址址（工工作作簿簿代代码码）点击信息B B列列录录入入数数据据时时在在A A列列返返回回记记录录时时间间（工工作作表表代代码码）点击事件当当指指定定区区域域修修改改时时在在其其右右侧侧的的2 2个个单单元元返返回回当当
9、前前日日期期和和时时间间（工工作作表表代代码码）点击单元赋值指指定定单单元元显显示示光光标标位位置置内内容容（工工作作表表代代码码）点击单元赋值每编辑一个单元保存文件点击事件指定允许编辑区域点击编辑解除允许编辑区域限制点击编辑删除指定行点击行列操作删除A列为指定内容的行点击行列操作删除A列非数字单元行点击行列操作有条件删除当前行点击行列操作选选择择下下一一行行点击定位选选择择第第5 5行行开开始始所所有有数数据据行行点击定位选选择择光光标标或或选选区区所所在在行行点击定位选选择择光光标标或或选选区区所所在在列列点击定位光光标标定定位位到到名名称称指指定定位位置置点击名称选选择择名名称称定定义义
10、的的数数据据区区点击名称选选择择到到指指定定列列的的最最后后行行点击定位将Sheet1的A列的非空值写到Sheet2的A列点击单元赋值将名称1的数据写到名称2点击名称单元反选点击定位调调整整选选中中对对象象中中的的文文字字点击格式去去除除指指定定范范围围内内的的对对象象点击对象更更新新透透视视表表数数据据项项点击数据将将全全部部工工作作表表名名称称写写到到A A列列点击单元赋值为为当当前前选选定定的的多多单单元元插插入入指指定定名名称称点击名称删删除除全全部部名名称称点击名称以以指指定定区区域域为为表表目目录录补补充充新新表表点击工作表按按A A列列数数据据批批量量修修改改表表名名称称点击工作
11、表按按A A列列数数据据批批量量创创建建新新表表(控控件件按按钮钮代代码码)点击工作表清除剪贴板点击其他批量清除软回车点击其他判断指定文件是否已经打开点击事件当前文件另存到指定目录点击文件管理另存指定文件名点击文件管理以本工作表名称另存文件到当前目录点击文件管理将本工作表单独另存文件到Excel当前默认目录点击文件管理以活动工作表名称另存文件到Excel当前默认目录点击文件管理另存所有工作表为工作簿点击文件管理以指定单元内容为新文件名另存文件点击文件管理以当前日期为新文件名另存文件点击文件管理以当前日期和时间为新文件名另存文件点击文件管理另另存存本本表表为为TXTTXT文文件件点击文件管理引用
12、指定位置单元内容为部分文件名另存文件点击文件管理将A列数据排序到D列点击单元赋值将将指指定定范范围围的的数数据据排排列列到到D D列列点击单元赋值光标移动点击定位光标所在行上移一行点击行列操作加数据有效限制点击数据取消数据有效限制点击数据重排窗口点击窗口按当前单元文本选择打开指定文件单元点击定位回车光标向右点击定位回车光标向下点击定位保护工作表时取消选定锁定单元点击工作表保存并退出Excel点击文件管理隐藏/显示指定列空值行点击行列操作深度隐藏指定工作表点击工作表隐藏指定工作表点击工作表隐藏当前工作表点击工作表返回当前工作表名称点击工作表获取上一次所进入工作簿的工作表名称点击工作表按光标选定颜
13、色隐藏本列其他颜色行点击格式打开工作簿自动隐藏录入表以外的其他表点击工作表除最左边工作表外深度隐藏所有表点击工作表关闭文件时自动隐藏指定工作表(ThisWorkbook)点击工作表打开文件时提示指定工作表是保护状态(ThisWorkbook)点击工作表插入10行点击行列操作全选固定范围内小于0的单元点击定位全选选定范围内小于0的单元点击定位固固定定区区域域单单元元分分类类变变色色点击格式A列半角内容变红点击格式单元格录入数据时运行宏的代码点击事件焦点到A列时运行宏的代码点击事件根据B列最后数据快速合并A列单元格的控件代码点击数据在F1单元显示光标位置批注内容的代码点击其他显示光标所在单元的批注
14、的代码点击其他使使单单元元内内容容保保持持不不变变的的工工作作表表代代码码点击单元赋值有有条条件件执执行行宏宏点击事件有有条条件件执执行行不不同同的的宏宏点击事件提提示示确确定定或或取取消消执执行行宏宏点击事件提提示示开开始始和和结结束束点击事件拷贝指定表不相邻多列数据到新位置点击单元赋值选择2至4行点击定位在当前选区有条件替换数值为文本点击事件自动筛选全部显示指定列点击筛选自动筛选第2列值为A的行点击筛选取消自动筛选()点击筛选全部显示指定表的自动筛选点击筛选强行合并单元点击格式设置单元区域格式点击格式在所有工作表的A1单元返回顺序号点击单元赋值根根据据A1A1单单元元内内容容返返回回C1C
15、1数数值值点击事件根根据据A1A1内内容容选选择择执执行行宏宏点击事件删除A列空行点击行列操作在在A A列列产产生生不不重重复复随随机机数数点击单元赋值将将A A列列数数据据随随机机排排列列到到F F列列点击单元赋值取取消消选选定定区区域域的的公公式式只只保保留留值值(假假空空转转真真空空)点击单元赋值处理导入的显示为科学计数法样式的身份证号点击其他返回指定单元的行高和列宽点击信息指定行高和列宽点击格式指定单元的行高和列宽与A1单元相同点击格式填公式点击单元赋值建立当前工作表的副本为001表点击工作表在第一个表前插入多工作表点击工作表清除A列再插入序号点击单元赋值反方向文本(自定义函数)点击自
16、定义函数指定选择单元区域弹出消息点击信息将B列数据添加超链接到K列点击超链接删除B列数据的超链接点击超链接分离临时表A列数据的文本和超链接并整理到数据库表 点击超链接分离临时表A列数据的文本和超链接并会同其他数据整理到数据库表点击超链接返返回回A A列列最最后后一一个个非非空空单单元元行行号号点击查找和引用返回表中第一个非空单元地址(行搜索)点击查找和引用返回表中各非空单元区域地址(行搜索)点击查找和引用返回第一个数值行号点击查找和引用返返回回第第1 1行行最最右右边边非非空空单单元元的的列列号号点击查找和引用返返回回连连续续数数值值单单元元的的数数量量点击查找和引用统统计计指指定定范范围围和
17、和内内容容的的单单元元数数量量点击查找和引用统统计计不不同同颜颜色色的的数数字字的的和和（自自定定义义函函数数）点击查找和引用返回非空单元数量点击查找和引用返回A列非空单元数量点击查找和引用返回圆周率点击其他定义指定单元内容为页眉/页脚点击打印提示并全部清除当前选择区域点击单元赋值全部清除当前选择区域点击单元赋值清除指定区域数值点击单元赋值对指定工作表执行取消隐藏打印隐藏工作表点击打印打开文件时执行指定宏(工作簿代码)点击事件关闭文件时执行指定宏(工作簿代码)点击事件弹出提示A1单元内容点击信息延延时时1515秒秒执执行行重重排排窗窗口口宏宏点击事件撤消工作表保护并取消密码点击工作表重算指定表
18、点击工作表将第5行移到窗口的最上面点击窗口对第一张工作表的指定区域进行排序点击单元赋值显示指定工作表的打印预览点击打印用单元格A1的内容作为文件名另存当前工作簿点击文件管理禁用/启用保存和另存的代码点击文件管理在A和B列返回当前选区的名称和公式点击单元赋值朗读朗读A列,按ESC键中止点击语音朗读固定语句，请按ESC键终止点击语音在M和N列的14行以下选择单元时显示调用日历控件（工作表代码）点击对象添加自定义序列点击其他弹出打印对话框点击打印返回总页码点击打印合并各工作表内容点击事件合并指定目录中所有文件中相同格式工作表的数据点击事件隐藏指定工作表的指定列点击工作表把a列不重复值取到e列点击查找
19、和引用当前选区的行列数点击查找和引用单元格录入1位字符就跳转(工作表代码)点击工作表当指定日期（每月10日）打开文件执行宏点击事件提示并清空单元区域点击事件返回光标所在行号点击其他VBA返回公式结果点击其他按照当前行A列的图片名称插入图片到H列点击图片当前行下插入1行点击工作表取消指定行或列的隐藏点击工作表复制单元格所在行点击其他复制单元格所在列点击其他新建一个工作表点击工作表新建一个工作簿点击工作簿选择多表为工作组点击工作表在当前工作组各表中分别执行指定宏点击事件复制当前工作簿的报表到临时工作簿点击工作簿删除指定文件点击工作簿合并A1至C1的内容写到D15单元的批注中点击批注自动重算点击其他
20、手动重算点击其他帖子地址http:/ 打打开开全全部部隐隐藏藏工工作作表表返回Sub 打开全部隐藏工作表()Dim i As IntegerFor i=1 To Sheets.Count Sheets(i).Visible=TrueNext iEnd Sub 循循环环宏宏返回Sub 循环()AAA=Range(C2)Dim i As Long Dim times As Long times=AAA times代表循环次数，执行前把times赋值即可(不可小于1，不可大于2147483647)For i=1 To timesCall 过滤一行 If Range(完成标志)=完成 Then Exi
21、t For 如果名为完成标志的命名单元的值等于完成,则退出循环,如果一开始就等于完成,则只执行一次循环就退出 If Sheets(传送参数).Range(A&i).Text=完成 Then Exit For 如果某列出现完成内容则退出循环 Next iEnd Sub 录录制制宏宏时时调调用用“停停止止录录制制”工工具具栏栏返回Sub 录制宏时调用停止录制工具栏()Application.CommandBars(Stop Recording).Visible=TrueEnd Sub 高高级级筛筛选选5 5列列不不重重复复数数据据至至指指定定表表返回Sub 高级筛选5列不重复数据至Sheet2()
22、Sheets(Sheet2).Range(A1:E65536)=清除Sheet2的A:D列8/152 Range(A1:E65536).AdvancedFilter Action:=xlFilterCopy,CopyToRange:=Sheet2.Range(_ A1),Unique:=True Sheet2.Columns(A:E).Sort Key1:=Sheet2.Range(A2),Order1:=xlAscending,Header:=xlGuess,_ OrderCustom:=1,MatchCase:=False,Orientation:=xlTopToBottom,SortMe
23、thod _ :=xlPinYinEnd Sub 双双击击单单元元执执行行宏宏(工工作作表表代代码码)返回Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range,Cancel As Boolean)If Range($A$1)=关闭 Then Exit Sub Select Case Target.Address Case$A$4 Call 宏1 Cancel=True Case$B$4 Call 宏2 Cancel=True Case$C$4 Call 宏3 Cancel=True Case$E$4 Call 宏4 Canc
24、el=True End SelectEnd Sub 双双击击指指定定区区域域单单元元执执行行宏宏(工工作作表表代代码码)返回Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range,Cancel As Boolean)IfIf Range($A$1)Range($A$1)=关关闭闭 ThenThen ExitExit SubSub If Not Application.Intersect(Target,Range(A4:A9,C4:C9)Is Nothing Then Call 打打开开隐隐藏藏表表End Sub 进进入入单单元
25、元执执行行宏宏(工工作作表表代代码码)返回Private Sub Worksheet_SelectionChange(ByVal Target As Range)9/152 以单元格进入代替按钮对象调用宏 If Range($A$1)=关闭 Then Exit Sub Select Case Target.Address Case$A$5 单元地址(Target.Address),或命名单元名字(Target.Name)Call 宏1 Case$B$5 Call 宏2 Case$C$5 Call 宏3 End SelectEnd Sub 进进入入指指定定区区域域单单元元执执行行宏宏(工工作作表
26、表代代码码)返回Private Sub Worksheet_SelectionChange(ByVal Target As Range)IfIf Range($A$1)Range($A$1)=关关闭闭 ThenThen ExitExit SubSub If Not Application.Intersect(Target,Range(A4:A9,C4:C9)Is Nothing Then Call 打打开开隐隐藏藏表表End Sub 在在多多个个宏宏中中依依次次循循环环执执行行一一个个（控控件件按按钮钮代代码码）返回Private Sub CommandButton1 1_Click()Sta
27、tic RunMacro As IntegerSelect Case RunMacroCase 0 宏1 RunMacro=1Case 1 宏2 RunMacro=2Case 2 宏3 RunMacro=0End SelectEnd Sub10/152 在在两两个个宏宏中中依依次次循循环环执执行行一一个个并并相相应应修修改改按按钮钮名名称称（控控件件按按钮钮代代码码）返回Private Sub CommandButton1 1_Click()With CommandButton1 1 If.Caption=保护工作表 Then Call 保护工作表 .Caption=取消工作表保护 Exit
28、Sub End If If.Caption=取消工作表保护 Then Call 取消工作表保护 .Caption=保护工作表 Exit Sub End IfEnd WithEnd Sub 在在三三个个宏宏中中依依次次循循环环执执行行一一个个并并相相应应修修改改按按钮钮名名称称（控控件件按按钮钮代代码码）返回Option ExplicitPrivate Sub CommandButton1 1_Click()With CommandButton1 1 If.Caption=宏1 Then Call 宏1 .Caption=宏2 Exit Sub End If If.Caption=宏2 Then
29、 Call 宏2 .Caption=宏3 Exit Sub End If If.Caption=宏3 Then Call 宏3 .Caption=宏1 Exit Sub11/152 End IfEnd WithEnd Sub 根根据据A1A1单单元元文文本本隐隐藏藏/显显示示按按钮钮（控控件件按按钮钮代代码码）返回Private Sub Worksheet_SelectionChange(ByVal Target As Range)If Range(A1)2 ThenCommandButton1.Visible=1ElseCommandButton1.Visible=0End IfEnd Su
30、bPrivate Sub CommandButton1_Click()重排窗口End Sub 当当前前单单元元返返回回按按钮钮名名称称（控控件件按按钮钮代代码码）返回Private Sub CommandButton1_Click()ActiveCell=CommandButton1.CaptionEnd Sub 当当前前单单元元内内容容返返回回到到按按钮钮名名称称（控控件件按按钮钮代代码码）返回Private Sub CommandButton1_Click()CommandButton1.Caption=ActiveCellEnd Sub 奇奇偶偶页页分分别别打打印印返回Sub 奇偶页分别
31、打印()Dim i%,Ps%Ps=ExecuteExcel4Macro(GET.DOCUMENT(50)总页数 MsgBox 现在打印奇数页,按确定开始.For i=1 To Ps Step 212/152 ActiveSheet.PrintOut from:=i,To:=i Next i MsgBox 现在打印偶数页,按确定开始.For i=2 To Ps Step 2 ActiveSheet.PrintOut from:=i,To:=i Next iEnd Sub 自自动动打打印印多多工工作作表表第第一一页页返回Sub 自动打印多工作表第一页()Dim sh As IntegerDim x
32、Dim yDim syDim syzx=InputBox(请输入起始工作表名字:)sy=InputBox(请输入结束工作表名字:)y=Sheets(x).Indexsyz=Sheets(sy).Index For sh=y To syz Sheets(sh).Select Sheets(sh).PrintOut from:=1,To:=1 Next shEnd Sub 查查找找A A列列文文本本循循环环插插入入分分页页符符返回SubSub 循循环环插插入入分分页页符符()()SelectionSelection =Workbooks(Workbooks(临临时时表表).Sheets().She
33、ets(表表2).Range(A1)2).Range(A1)调调用用指指定定地地址址内内容容 DimDim i i AsAs LongLong DimDim timestimes AsAs LongLong timestimes =Application.WorksheetFunction.CountIf(Sheet1.Range(a:a),Application.WorksheetFunction.CountIf(Sheet1.Range(a:a),分分页页)timestimes代代表表循循环环次次数数，执执行行前前把把timestimes赋赋值值即即可可(不不可可小小于于1 1，不不可可大
34、大于于2147483647)2147483647)ForFor i i =1 1 ToTo timestimes13/152CallCall 插插入入分分页页符符 NextNext i iEndEnd SubSubSubSub 插插入入分分页页符符()()Cells.Find(What:=Cells.Find(What:=分分页页,After:=ActiveCell,After:=ActiveCell,LookIn:=xlValues,LookIn:=xlValues,LookAt:=LookAt:=_ _ xlPart,xlPart,SearchOrder:=xlByRows,SearchO
35、rder:=xlByRows,SearchDirection:=xlNext,SearchDirection:=xlNext,MatchCase:=False)MatchCase:=False)_ _ .Activate.Activate ActiveWindow.SelectedSheets.HPageBreaks.AddActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCellBefore:=ActiveCellEndEnd SubSubSub 取消原分页()Cells.Select ActiveSheet.ResetAll
36、PageBreaksEnd Sub 将将A A列列最最后后数数据据行行以以上上的的所所有有B 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 Pic.Left=P
37、ic.TopLeftCell.Left Pic.Height=Pic.TopLeftCell.Height Pic.Width=Pic.TopLeftCell.Width End If NextEnd Sub 返返回回光光标标所所在在行行数数返回Sub 返回光标所在行数()x=ActiveCell.Row Range(A1)=x14/152End Sub 在在A1A1返返回回当当前前选选中中单单元元格格数数量量返回Sub 在A1返回当前选中单元格数量()A1=Selection.CountEnd Sub 返返回回当当前前工工作作簿簿中中工工作作表表数数量量返回Sub 返回当前工作簿中工作表数量
38、()t=Application.Sheets.CountMsgBox tEnd Sub 返返回回光光标标选选择择区区域域的的行行数数和和列列数数返回Sub 返回光标选择区域的行数和列数()x=Selection.Rows.County=Selection.Columns.CountRange(A1)=xRange(A2)=yEnd Sub 工工作作表表中中包包含含数数据据的的最最大大行行数数返回Sub 包含数据的最大行数()n=Cells.Find(*,1,2).RowMsgBox nEnd Sub 返返回回A A列列数数据据的的最最大大行行数数返回Sub 返回A列数据的最大行数()n=Ran
39、ge(a65536).End(xlUp).RowRange(B1)=nEnd Sub 将将所所选选区区域域文文本本插插入入新新建建文文本本框框返回15/152Sub 将所选区域文本插入新建文本框()For Each rag In Selectionn=n&rag.Value&Chr(10)Next ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal,ActiveCell.Left+ActiveCell.Width,ActiveCell.Top+ActiveCell.Height,250#,100).Select Selectio
40、n.Characters.Text=问题：&n With Selection.Characters(Start:=1,Length:=3).Font .Name=黑体 .FontStyle=常规 .Size=12 End WithEnd Sub 批批量量插插入入地地址址批批注注返回Sub 批量插入地址批注()On Error Resume NextDim r As RangeIf Selection.Cells.Count 0 ThenFor Each r In Selectionr.Comment.Deleter.AddCommentr.Comment.Visible=Falser.Comm
41、ent.Text Text:=本单元格：&r.Address&of&Selection.AddressNextEnd IfEnd Sub 批批量量插插入入统统一一批批注注返回Sub 批量插入统一批注()Dim r As Range,msg As Stringmsg=InputBox(请输入欲批量插入的批注,提示,随便输点什么吧)If Selection.Cells.Count 0 ThenFor Each r In Selectionr.AddComment16/152r.Comment.Visible=Falser.Comment.Text Text:=msgNextEnd IfEnd Su
42、b 以以A1A1单单元元内内容容批批量量插插入入批批注注返回Sub 以A1单元内容批量插入批注()Dim r As RangeIf Selection.Cells.Count 0 ThenFor Each r In Selectionr.AddCommentr.Comment.Visible=Falser.Comment.Text Text:=a1.TextNextEnd IfEnd Sub 不不连连续续区区域域插插入入当当前前文文件件名名和和表表名名及及地地址址返回Sub 批量插入当前文件名和表名及地址()For Each mycell In Selection mycell.Formula
43、R1C1=+ActiveWorkbook.Name+ActiveSheet.Name+!+mycell.Address NextEnd Sub 不不连连续续区区域域录录入入当当前前单单元元地地址址返回Sub 区域录入当前单元地址()For Each mycell In Selection mycell.FormulaR1C1=mycell.Address NextEnd Sub 连连续续区区域域录录入入当当前前单单元元地地址址返回Sub 连续区域录入当前单元地址()17/152 Selection=ADDRESS(ROW(),COLUMN(),4,1)Selection.Copy Select
44、ion.PasteSpecial Paste:=xlPasteValues,Operation:=xlNone,SkipBlanks _ :=False,Transpose:=FalseEnd Sub 返返回回当当前前单单元元地地址址返回Sub 返回当前单元地址()d=ActiveCell.AddressA1=dEnd Sub 不不连连续续区区域域录录入入当当前前日日期期返回Sub 区域录入当前日期()Selection.FormulaR1C1=Format(Now(),yyyy-m-d)End Sub 不不连连续续区区域域录录入入当当前前数数字字日日期期返回Sub 区域录入当前数字日期()S
45、election.FormulaR1C1=Format(Now(),yyyymmdd)End Sub 不不连连续续区区域域录录入入当当前前日日期期和和时时间间返回Sub 区域录入当前日期和时间()Selection.FormulaR1C1=Format(Now(),yyyy-m-d h:mm:ss)End Sub 不不连连续续区区域域录录入入对对勾勾返回Sub 批量录入对勾()Selection.FormulaR1C1=End Sub 不不连连续续区区域域录录入入当当前前文文件件名名返回Sub 批量录入当前文件名()18/152Selection.FormulaR1C1=ThisWorkboo
46、k.NameEnd Sub 不不连连续续区区域域添添加加文文本本返回Sub 批量添加文本()Dim s As RangeFor Each s In Selections=s&文本内容NextEnd Sub 不不连连续续区区域域插插入入文文本本返回Sub 批量插入文本()Dim s As RangeFor Each s In Selections=文本内容&sNextEnd Sub 从从指指定定位位置置向向下下同同时时录录入入多多单单元元指指定定内内容容返回Sub 从指定位置向下同时录入多单元指定内容()Dim arrarr=Array(1,2,13,25,46,12,0,20)B2.Resiz
47、e(8,1)=Application.WorksheetFunction.Transpose(arr)End Sub 按按aaaa工工作作表表A A列列的的内内容容排排列列工工作作表表标标签签顺顺序序返回Sub 按aa工作表A列的内容排列工作表标签顺序()Dim I%,str1$I=1 Sheets(aa).Select Do While Cells(I,1).Value str1=Trim(Cells(I,1).Value)19/152 Sheets(str1).Select Sheets(str1).Move after:=Sheets(I)I=I+1 Sheets(aa).Select
48、LoopEnd Sub 以以A1A1单单元元文文本本作作表表名名插插入入工工作作表表返回Sub 以A1单元文本作表名插入工作表()Dim nm As String nm=a1 Sheets.Add ActiveSheet.Name=nmEnd Sub 删删除除全全部部未未选选定定工工作作表表返回Sub 删除全部未选定工作表()Dim sht As Worksheet,n As Integer,iFlag As Boolean Dim ShtName()As String n=ActiveWindow.SelectedSheets.Count ReDim ShtName(1 To n)n=1 F
49、or Each sht In ActiveWindow.SelectedSheets ShtName(n)=sht.Name n=n+1 Next Application.DisplayAlerts=False For Each sht In Sheets iFlag=False For i=1 To n-1 If ShtName(i)=sht.Name Then iFlag=True Exit For20/152 End If Next If Not iFlag Then sht.Delete Next Application.DisplayAlerts=TrueEnd Sub 工工作作表表
50、标标签签排排序序返回Sub 工作表标签排序()Dim i As Long,j As Long,nums As Long,msg As Longmsg=MsgBox(工作表按升序排列请选 是Y.&vbCrLf&vbCrLf&工作表按降序排列请选 否N,vbYesNoCancel,工作表排序)If msg=vbCancel Then Exit Subnums=Sheets.Count If msg=vbYes Then Sort ascending For i=1 To nums For j=i To nums If UCase(Sheets(j).Name)UCase(Sheets(i).Nam