_Exce宏大全(经典)

代码目录链接类别ＥＨ帖子地址http://club.excelhome.net/dispbbs.asp?boardid=4&id=239820打开全部隐藏工作 表 关于同志近三年现实表现材料材料类招标技术评分表图表与交易pdf视力表打印pdf用图表说话 pdf 点击工作表循环宏点击宏管理录制宏时调用“停止录制”工具栏点击其他高级筛选5列不重复数据至指定表点击筛选双击单元执行宏(工作表代码)点击宏管理双击指定区域单元执行宏(工作表代码)点击宏管理进入单元执行宏(工作表代码)点击宏管理进入指定区域单元执行宏(工作表代码)点击宏管理在多个宏中依次循环执行一个（控件按钮代码）点击宏管理在两个宏中依次循环执行一个并相应修改按钮名称（控件按钮代码）点击宏管理在三个宏中依次循环执行一个并相应修改按钮名称（控件按钮代码）点击宏管理根据A1单元文本隐藏/显示按钮（控件按钮代码）点击控件当前单元返回按钮名称（控件按钮代码）点击控件当前单元内容返回到按钮名称（控件按钮代码）点击控件奇偶页分别打印点击打印自动打印多工作表第一页点击打印查找A列文本循环插入分页符点击打印将A列最后数据行以上的所有B列图片大小调整为所在单元大小点击对象返回光标所在行数点击查找和引用在A1返回当前选中单元格数量点击查找和引用返回当前工作簿中工作表数量点击查找和引用返回光标选择区域的行数和列数点击查找和引用工作表中包含数据的最大行数点击查找和引用返回A列数据的最大行数点击查找和引用将所选区域文本插入新建文本框点击对象批量插入地址批注点击批注批量插入统一批注点击批注以A1单元内容批量插入批注点击批注不连续区域插入当前文件名和表名及地址点击单元赋值不连续区域录入当前单元地址点击单元赋值连续区域录入当前单元地址点击单元赋值返回当前单元地址点击单元赋值不连续区域录入当前日期点击单元赋值不连续区域录入当前数字日期点击单元赋值不连续区域录入当前日期和时间点击单元赋值不连续区域录入对勾点击单元赋值不连续区域录入当前文件名点击单元赋值不连续区域添加文本点击单元赋值不连续区域插入文本点击单元赋值从指定位置向下同时录入多单元指定内容点击单元赋值按aa工作表A列的内容排列工作表标签顺序点击工作表以A1单元文本作表名插入工作表点击工作表删除全部未选定工作表点击工作表工作表标签排序点击工作表定义指定工作表标签颜色点击工作表在目录表建立本工作簿中各表链接目录点击文件管理建立工作表文本目录点击工作表查另一文件的全部表名点击工作表当前单元录入计算机名点击单元赋值当前单元录入计算机用户名点击单元赋值解除全部工作表保护点击工作表为指定工作表加指定密码保护表点击密码在有密码的工作表执行代码点击密码执行前需要验证密码的宏(控件按钮代码)点击密码拷贝A1 公式 小学单位换算公式大全免费下载公式下载行测公式大全下载excel公式下载逻辑回归公式下载 和格式到A2点击单元赋值复制单元数值点击单元赋值插入数值条件格式点击格式插入透明批注点击批注添加文本点击单元赋值光标定位到指定工作表A列最后数据行下一单元点击定位定位选定单元格式相同的全部单元格点击定位按当前单元文本定位点击定位按固定文本定位点击定位删除包含固定文本单元的行或列点击定位定位数据及区域以上的空值点击定位右侧单元自动加5(工作表代码)点击单元赋值当前单元加2点击单元赋值A列等于A列减B列点击单元赋值用于光标选定多区域跳转指定单元(工作表代码)点击定位将A1单元录入的数据累加到B1单元（工作表代码）点击单元赋值在指定颜色区域选择单元时添加/取消"√"（工作表代码）点击单元赋值在指定区域选择单元时添加/取消"√"（工作表代码）点击单元赋值双击指定单元，循环录入文本（工作表代码）点击单元赋值单元区域引用（工作表代码）点击单元赋值在指定区域选择单元时数值加1（工作表代码）点击单元赋值混合文本的编号点击单元赋值指定区域单元双击数据累加（工作表代码）点击单元赋值选择单元区域触发事件（工作表代码）点击事件当修改指定单元内容时自动执行宏（工作表代码）点击事件被指定单元内容限制执行宏点击事件双击单元隐藏该行（工作表代码）点击事件高亮显示行（工作表代码）点击其他高亮显示行和列（工作表代码）点击其他为指定工作表设置滚动范围（工作簿代码）点击定位在指定单元记录打印和预览次数（工作簿代码）点击打印自动数字金额转大写（工作表代码）点击单元赋值将全部工作表的A1单元作为单击按钮（工作簿代码）点击对象闹钟——到指定时间执行宏（工作簿代码）点击事件改变Excel界面标题的宏（工作簿代码）点击其他在指定工作表的指定单元返回光标当前多选区地址（工作簿代码）点击信息B列录入数据时在A列返回记录时间（工作表代码）点击事件当指定区域修改时在其右侧的2个单元返回当前日期和时间（工作表代码）点击单元赋值指定单元显示光标位置内容（工作表代码）点击单元赋值每编辑一个单元保存文件点击事件指定允许编辑区域点击编辑解除允许编辑区域限制点击编辑删除指定行点击行列操作删除A列为指定内容的行点击行列操作删除A列非数字单元行点击行列操作有条件删除当前行点击行列操作选择下一行点击定位选择第5行开始所有数据行点击定位选择光标或选区所在行点击定位选择光标或选区所在列点击定位光标定位到名称指定位置点击名称选择名称定义的数据区点击名称选择到指定列的最后行点击定位将Sheet1的A列的非空值写到Sheet2的A列点击单元赋值将名称1的数据写到名称2点击名称单元反选点击定位调整选中对象中的文字点击格式去除指定范围内的对象点击对象更新透视表数据项点击数据将全部工作表名称写到A列点击单元赋值为当前选定的多单元插入指定名称点击名称删除全部名称点击名称以指定区域为表目录补充新表点击工作表按A列数据批量修改表名称点击工作表按A列数据批量创建新表(控件按钮代码)点击工作表清除剪贴板点击其他批量清除软回车点击其他判断指定文件是否已经打开点击事件当前文件另存到指定目录点击文件管理另存指定文件名点击文件管理以本工作表名称另存文件到当前目录点击文件管理将本工作表单独另存文件到Excel当前默认目录点击文件管理以活动工作表名称另存文件到Excel当前默认目录点击文件管理另存所有工作表为工作簿点击文件管理以指定单元内容为新文件名另存文件点击文件管理以当前日期为新文件名另存文件点击文件管理以当前日期和时间为新文件名另存文件点击文件管理另存本表为TXT文件点击文件管理引用指定位置单元内容为部分文件名另存文件点击文件管理将A列数据排序到D列点击单元赋值将指定范围的数据排列到D列点击单元赋值光标移动点击定位光标所在行上移一行点击行列操作加数据有效限制点击数据取消数据有效限制点击数据重排窗口点击窗口按当前单元文本选择打开指定文件单元点击定位回车光标向右点击定位回车光标向下点击定位保护工作表时取消选定锁定单元点击工作表保存并退出Excel点击文件管理隐藏/显示指定列空值行点击行列操作深度隐藏指定工作表点击工作表隐藏指定工作表点击工作表隐藏当前工作表点击工作表返回当前工作表名称点击工作表获取上一次所进入工作簿的工作表名称点击工作表按光标选定颜色隐藏本列其他颜色行点击格式打开工作簿自动隐藏录入表以外的其他表点击工作表除最左边工作表外深度隐藏所有表点击工作表关闭文件时自动隐藏指定工作表(ThisWorkbook)点击工作表打开文件时提示指定工作表是保护状态(ThisWorkbook)点击工作表插入10行点击行列操作全选固定范围内小于0的单元点击定位全选选定范围内小于0的单元点击定位固定区域单元分类变色点击格式A列半角内容变红点击格式单元格录入数据时运行宏的代码点击事件焦点到A列时运行宏的代码点击事件根据B列最后数据快速合并A列单元格的控件代码点击数据在F1单元显示光标位置批注内容的代码点击其他显示光标所在单元的批注的代码点击其他使单元内容保持不变的工作表代码点击单元赋值有条件执行宏点击事件有条件执行不同的宏点击事件提示确定或取消执行宏点击事件提示开始和结束点击事件拷贝指定表不相邻多列数据到新位置点击单元赋值选择2至4行点击定位在当前选区有条件替换数值为文本点击事件自动筛选全部显示指定列点击筛选自动筛选第2列值为A的行点击筛选取消自动筛选()点击筛选全部显示指定表的自动筛选点击筛选强行合并单元点击格式设置单元区域格式点击格式在所有工作表的A1单元返回顺序号点击单元赋值根据A1单元内容返回C1数值点击事件根据A1内容选择执行宏点击事件删除A列空行点击行列操作在A列产生不重复随机数点击单元赋值将A列数据随机排列到F列点击单元赋值取消选定区域的公式只保留值(假空转真空)点击单元赋值处理导入的显示为科学计数法样式的身份证号点击其他返回指定单元的行高和列宽点击信息指定行高和列宽点击格式指定单元的行高和列宽与A1单元相同点击格式填公式点击单元赋值建立当前工作表的副本为001表点击工作表在第一个表前插入多工作表点击工作表清除A列再插入序号点击单元赋值反方向文本(自定义函数)点击自定义函数指定选择单元区域弹出消息点击信息将B列数据添加超链接到K列点击超链接删除B列数据的超链接点击超链接分离临时表A列数据的文本和超链接并整理到数据库表点击超链接分离临时表A列数据的文本和超链接并会同其他数据整理到数据库表点击超链接返回A列最后一个非空单元行号点击查找和引用返回表中第一个非空单元地址(行搜索)点击查找和引用返回表中各非空单元区域地址(行搜索)点击查找和引用返回第一个数值行号点击查找和引用返回第1行最右边非空单元的列号点击查找和引用返回连续数值单元的数量点击查找和引用统计指定范围和内容的单元数量点击查找和引用统计不同颜色的数字的和（自定义函数）点击查找和引用返回非空单元数量点击查找和引用返回A列非空单元数量点击查找和引用返回圆周率π点击其他定义指定单元内容为页眉/页脚点击打印提示并全部清除当前选择区域点击单元赋值全部清除当前选择区域点击单元赋值清除指定区域数值点击单元赋值对指定工作表执行取消隐藏》打印》隐藏工作表点击打印打开文件时执行指定宏(工作簿代码)点击事件关闭文件时执行指定宏(工作簿代码)点击事件弹出提示A1单元内容点击信息延时15秒执行重排窗口宏点击事件撤消工作表保护并取消密码点击工作表重算指定表点击工作表将第5行移到窗口的最上面点击窗口对第一张工作表的指定区域进行排序点击单元赋值显示指定工作表的打印预览点击打印用单元格A1的内容作为文件名另存当前工作簿点击文件管理[禁用/启用]保存和另存的代码点击文件管理在A和B列返回当前选区的名称和公式点击单元赋值朗读朗读A列,按ESC键中止点击语音朗读固定语句，请按ESC键终止点击语音在M和N列的14行以下选择单元时显示调用日历控件（工作表代码）点击对象添加自定义序列点击其他弹出打印对话框点击打印返回总页码点击打印合并各工作表内容点击事件合并指定目录中所有文件中相同格式工作表的数据点击事件隐藏指定工作表的指定列点击工作表把a列不重复值取到e列点击查找和引用当前选区的行列数点击查找和引用单元格录入1位字符就跳转(工作表代码)点击工作表当指定日期（每月10日）打开文件执行宏点击事件提示并清空单元区域点击事件返回光标所在行号点击其他VBA返回公式结果点击其他按照当前行A列的图片名称插入图片到H列点击图片当前行下插入1行点击工作表取消指定行或列的隐藏点击工作表复制单元格所在行点击其他复制单元格所在列点击其他新建一个工作表点击工作表新建一个工作簿点击工作簿选择多表为工作组点击工作表在当前工作组各表中分别执行指定宏点击事件复制当前工作簿的报表到临时工作簿点击工作簿删除指定文件点击工作簿合并A1至C1的内容写到D15单元的批注中点击批注自动重算点击其他手动重算点击其他宏文件集▲打开全部隐藏工作表返回Sub打开全部隐藏工作表()DimiAsIntegerFori=1ToSheets.CountSheets(i).Visible=TrueNextiEndSub▲循环宏返回Sub循环()AAA=Range("C2")DimiAsLongDimtimesAsLongtimes=AAA'times代表循环次数，执行前把times赋值即可(不可小于1，不可大于2147483647)Fori=1TotimesCall过滤一行IfRange("完成标志")="完成"ThenExitFor'如果名为'完成标志'的命名单元的值等于'完成',则退出循环,如果一开始就等于'完成',则只执行一次循环就退出'IfSheets("传送参数").Range("A"&i).Text="完成"ThenExitFor'如果某列出现"完成"内容则退出循环NextiEndSub▲录制宏时调用“停止录制”工具栏返回Sub录制宏时调用停止录制工具栏()Application.CommandBars("StopRecording").Visible=TrueEndSub▲高级筛选5列不重复数据至指定表返回Sub高级筛选5列不重复数据至Sheet2()Sheets("Sheet2").Range("A1:E65536")=""'清除Sheet2的A:D列Range("A1:E65536").AdvancedFilterAction:=xlFilterCopy,CopyToRange:=Sheet2.Range(_"A1"),Unique:=TrueSheet2.Columns("A:E").SortKey1:=Sheet2.Range("A2"),Order1:=xlAscending,Header:=xlGuess,_OrderCustom:=1,MatchCase:=False,Orientation:=xlTopToBottom,SortMethod_:=xlPinYinEndSub▲双击单元执行宏(工作表代码)返回PrivateSubWorksheet_BeforeDoubleClick(ByValTargetAsRange,CancelAsBoolean)IfRange("$A$1")="关闭"ThenExitSubSelectCaseTarget.AddressCase"$A$4"Call宏1Cancel=TrueCase"$B$4"Call宏2Cancel=TrueCase"$C$4"Call宏3Cancel=TrueCase"$E$4"Call宏4Cancel=TrueEndSelectEndSub▲双击指定区域单元执行宏(工作表代码)返回PrivateSubWorksheet_BeforeDoubleClick(ByValTargetAsRange,CancelAsBoolean)IfRange("$A$1")="关闭"ThenExitSubIfNotApplication.Intersect(Target,Range("A4:A9","C4:C9"))IsNothingThenCall打开隐藏表EndSub▲进入单元执行宏(工作表代码)返回PrivateSubWorksheet_SelectionChange(ByValTargetAsRange)'以单元格进入代替按钮对象调用宏IfRange("$A$1")="关闭"ThenExitSubSelectCaseTarget.AddressCase"$A$5"'单元地址(Target.Address),或命名单元名字(Target.Name)Call宏1Case"$B$5"Call宏2Case"$C$5"Call宏3EndSelectEndSub▲进入指定区域单元执行宏(工作表代码)返回PrivateSubWorksheet_SelectionChange(ByValTargetAsRange)IfRange("$A$1")="关闭"ThenExitSubIfNotApplication.Intersect(Target,Range("A4:A9","C4:C9"))IsNothingThenCall打开隐藏表EndSub▲在多个宏中依次循环执行一个（控件按钮代码）返回PrivateSubCommandButton1_Click()StaticRunMacroAsIntegerSelectCaseRunMacroCase0宏1RunMacro=1Case1宏2RunMacro=2Case2宏3RunMacro=0EndSelectEndSub▲在两个宏中依次循环执行一个并相应修改按钮名称（控件按钮代码）返回PrivateSubCommandButton1_Click()WithCommandButton1If.Caption="保护工作表"ThenCall保护工作表.Caption="取消工作表保护"ExitSubEndIfIf.Caption="取消工作表保护"ThenCall取消工作表保护.Caption="保护工作表"ExitSubEndIfEndWithEndSub▲在三个宏中依次循环执行一个并相应修改按钮名称（控件按钮代码）返回OptionExplicitPrivateSubCommandButton1_Click()WithCommandButton1If.Caption="宏1"ThenCall宏1.Caption="宏2"ExitSubEndIfIf.Caption="宏2"ThenCall宏2.Caption="宏3"ExitSubEndIfIf.Caption="宏3"ThenCall宏3.Caption="宏1"ExitSubEndIfEndWithEndSub▲根据A1单元文本隐藏/显示按钮（控件按钮代码）返回PrivateSubWorksheet_SelectionChange(ByValTargetAsRange)IfRange("A1")>2ThenCommandButton1.Visible=1ElseCommandButton1.Visible=0EndIfEndSubPrivateSubCommandButton1_Click()重排窗口EndSub▲当前单元返回按钮名称（控件按钮代码）返回PrivateSubCommandButton1_Click()ActiveCell=CommandButton1.CaptionEndSub▲当前单元内容返回到按钮名称（控件按钮代码）返回PrivateSubCommandButton1_Click()CommandButton1.Caption=ActiveCellEndSub▲奇偶页分别打印返回Sub奇偶页分别打印()Dimi%,Ps%Ps=ExecuteExcel4Macro("GET.DOCUMENT(50)")'总页数MsgBox"现在打印奇数页,按确定开始."Fori=1ToPsStep2ActiveSheet.PrintOutfrom:=i,To:=iNextiMsgBox"现在打印偶数页,按确定开始."Fori=2ToPsStep2ActiveSheet.PrintOutfrom:=i,To:=iNextiEndSub▲自动打印多工作表第一页返回Sub自动打印多工作表第一页()DimshAsIntegerDimxDimyDimsyDimsyzx=InputBox("请输入起始工作表名字:")sy=InputBox("请输入结束工作表名字:")y=Sheets(x).Indexsyz=Sheets(sy).IndexForsh=yTosyzSheets(sh).SelectSheets(sh).PrintOutfrom:=1,To:=1NextshEndSub▲查找A列文本循环插入分页符返回Sub循环插入分页符()'Selection=Workbooks("临时表").Sheets("表2").Range("A1")调用指定地址内容DimiAsLongDimtimesAsLongtimes=Application.WorksheetFunction.CountIf(Sheet1.Range("a:a"),"分页")'times代表循环次数，执行前把times赋值即可(不可小于1，不可大于2147483647)Fori=1TotimesCall插入分页符NextiEndSubSub插入分页符()Cells.Find(What:="分页",After:=ActiveCell,LookIn:=xlValues,LookAt:=_xlPart,SearchOrder:=xlByRows,SearchDirection:=xlNext,MatchCase:=False)_.ActivateActiveWindow.SelectedSheets.HPageBreaks.AddBefore:=ActiveCellEndSubSub取消原分页()Cells.SelectActiveSheet.ResetAllPageBreaksEndSub▲将A列最后数据行以上的所有B列图片大小调整为所在单元大小返回Sub将A列最后数据行以上的所有B列图片大小调整为所在单元大小()DimPicAsPicture,i&i=[A65536].End(xlUp).RowForEachPicInSheet1.PicturesIfNotApplication.Intersect(Pic.TopLeftCell,Range("B1:B"&i))IsNothingThenPic.Top=Pic.TopLeftCell.TopPic.Left=Pic.TopLeftCell.LeftPic.Height=Pic.TopLeftCell.HeightPic.Width=Pic.TopLeftCell.WidthEndIfNextEndSub▲返回光标所在行数返回Sub返回光标所在行数()x=ActiveCell.RowRange("A1")=xEndSub▲在A1返回当前选中单元格数量返回Sub在A1返回当前选中单元格数量()[A1]=Selection.CountEndSub▲返回当前工作簿中工作表数量返回Sub返回当前工作簿中工作表数量()t=Application.Sheets.CountMsgBoxtEndSub▲返回光标选择区域的行数和列数返回Sub返回光标选择区域的行数和列数()x=Selection.Rows.County=Selection.Columns.CountRange("A1")=xRange("A2")=yEndSub▲工作表中包含数据的最大行数返回Sub包含数据的最大行数()n=Cells.Find("*",,,,1,2).RowMsgBoxnEndSub▲返回A列数据的最大行数返回Sub返回A列数据的最大行数()n=Range("a65536").End(xlUp).RowRange("B1")=nEndSub▲将所选区域文本插入新建文本框返回Sub将所选区域文本插入新建文本框()ForEachragInSelectionn=n&rag.Value&Chr(10)NextActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal,ActiveCell.Left+ActiveCell.Width,ActiveCell.Top+ActiveCell.Height,250#,100).SelectSelection.Characters.Text="问题："&nWithSelection.Characters(Start:=1,Length:=3).Font.Name="黑体".FontStyle="常规".Size=12EndWithEndSub▲批量插入地址批注返回Sub批量插入地址批注()OnErrorResumeNextDimrAsRangeIfSelection.Cells.Count>0ThenForEachrInSelectionr.Comment.Deleter.AddCommentr.Comment.Visible=Falser.Comment.TextText:="本单元格："&r.Address&"of"&Selection.AddressNextEndIfEndSub▲批量插入统一批注返回Sub批量插入统一批注()DimrAsRange,msgAsStringmsg=InputBox("请输入欲批量插入的批注","提示","随便输点什么吧")IfSelection.Cells.Count>0ThenForEachrInSelectionr.AddCommentr.Comment.Visible=Falser.Comment.TextText:=msgNextEndIfEndSub▲以A1单元内容批量插入批注返回Sub以A1单元内容批量插入批注()DimrAsRangeIfSelection.Cells.Count>0ThenForEachrInSelectionr.AddCommentr.Comment.Visible=Falser.Comment.TextText:=[a1].TextNextEndIfEndSub▲不连续区域插入当前文件名和表名及地址返回Sub批量插入当前文件名和表名及地址()ForEachmycellInSelectionmycell.FormulaR1C1="["+ActiveWorkbook.Name+"]"+ActiveSheet.Name+"!"+mycell.AddressNextEndSub▲不连续区域录入当前单元地址返回Sub区域录入当前单元地址()ForEachmycellInSelectionmycell.FormulaR1C1=mycell.AddressNextEndSub▲连续区域录入当前单元地址返回Sub连续区域录入当前单元地址()Selection="=ADDRESS(ROW(),COLUMN(),4,1)"Selection.CopySelection.PasteSpecialPaste:=xlPasteValues,Operation:=xlNone,SkipBlanks_:=False,Transpose:=FalseEndSub▲返回当前单元地址返回Sub返回当前单元地址()d=ActiveCell.Address[A1]=dEndSub▲不连续区域录入当前日期返回Sub区域录入当前日期()Selection.FormulaR1C1=Format(Now(),"yyyy-m-d")EndSub▲不连续区域录入当前数字日期返回Sub区域录入当前数字日期()Selection.FormulaR1C1=Format(Now(),"yyyymmdd")EndSub▲不连续区域录入当前日期和时间返回Sub区域录入当前日期和时间()Selection.FormulaR1C1=Format(Now(),"yyyy-m-dh:mm:ss")EndSub▲不连续区域录入对勾返回Sub批量录入对勾()Selection.FormulaR1C1="√"EndSub▲不连续区域录入当前文件名返回Sub批量录入当前文件名()Selection.FormulaR1C1=ThisWorkbook.NameEndSub▲不连续区域添加文本返回Sub批量添加文本()DimsAsRangeForEachsInSelections=s&"文本内容"NextEndSub▲不连续区域插入文本返回Sub批量插入文本()DimsAsRangeForEachsInSelections="文本内容"&sNextEndSub▲从指定位置向下同时录入多单元指定内容返回Sub从指定位置向下同时录入多单元指定内容()Dimarrarr=Array("1","2","13","25","46","12","0","20")[B2].Resize(8,1)=Application.WorksheetFunction.Transpose(arr)EndSub▲按aa工作表A列的内容排列工作表标签顺序返回Sub按aa工作表A列的内容排列工作表标签顺序()DimI%,str1$I=1Sheets("aa").SelectDoWhileCells(I,1).Value<>""str1=Trim(Cells(I,1).Value)Sheets(str1).SelectSheets(str1).Moveafter:=Sheets(I)I=I+1Sheets("aa").SelectLoopEndSub▲以A1单元文本作表名插入工作表返回Sub以A1单元文本作表名插入工作表()DimnmAsStringnm=[a1]Sheets.AddActiveSheet.Name=nmEndSub▲删除全部未选定工作表返回Sub删除全部未选定工作表()DimshtAsWorksheet,nAsInteger,iFlagAsBooleanDimShtName()AsStringn=ActiveWindow.SelectedSheets.CountReDimShtName(1Ton)n=1ForEachshtInActiveWindow.SelectedSheetsShtName(n)=sht.Namen=n+1NextApplication.DisplayAlerts=FalseForEachshtInSheetsiFlag=FalseFori=1Ton-1IfShtName(i)=sht.NameTheniFlag=TrueExitForEndIfNextIfNotiFlagThensht.DeleteNextApplication.DisplayAlerts=TrueEndSub▲工作表标签排序返回Sub工作表标签排序()DimiAsLong,jAsLong,numsAsLong,msgAsLongmsg=MsgBox("工作表按升序排列请选'是[Y]'."&vbCrLf&vbCrLf&"工作表按降序排列请选'否[N]'",vbYesNoCancel,"工作表排序")Ifmsg=vbCancelThenExitSubnums=Sheets.CountIfmsg=vbYesThen'SortascendingFori=1TonumsForj=iTonumsIfUCase(Sheets(j).Name)UCase(Sheets(i).Name)ThenSheets(j).MoveBefore:=Sheets(i)EndIfNextjNextiEndIfEndSub▲定义指定工作表标签颜色返回Sub定义指定工作表标签颜色()Sheets("Sheet1").Tab.ColorIndex=46EndSub▲在目录表建立本工作簿中各表链接目录返回Sub在目录表建立本工作簿中各表链接目录()Dims%,RngAsRangeOnErrorResumeNextSheets("目录").ActivateIfErr=0ThenSheets("目录").UsedRange.DeleteElseSheets.AddActiveSheet.Name="目录"EndIfFori=1ToSheets.CountIfSheets(i).Name<>"目录"Thens=s+1SetRng=Sheets("目录").Cells(((s-1)Mod20)+1,(s-1)\20+1+1)Rng=Format(s,"0")&"."&Sheets(i).NameActiveSheet.Hyperlinks.AddRng,"#"&Sheets(i).Name&"!A1",ScreenTip:=Sheets(i).NameEndIfNextSheets("目录").Range("b:iv").EntireColumn.ColumnWidth=20EndSub▲建立工作表文本目录返回Sub建立工作表文本目录()Sheets.Addbefore:=Sheets(1)Sheets(1).Name="目录"Fori=2ToSheets.CountCells(i-1,1)=Sheets(i).Name'Sheets(1).Hyperlinks.AddCells(i-1,1),"#"&Sheets(i).Name&"!A1"'添加超链接NextEndSub▲查另一文件的全部表名返回Sub查另一文件的全部表名()OnErrorResumeNextDimi%DimshAsWorksheetApplication.ScreenUpdating=FalseWorkbooks.OpenFilename:=ThisWorkbook.Path&"\2.xls"Windows("1.xls").Activate'当前文件名称Sheets("Sheet1").Select'当前表名称i=1'将表名称返回到第1行ForEachshInWorkbooks("2.xls").WorksheetsCells(i,1)=sh.Name'将表名称返回到第1列i=i+1'返回每个表名称向下移动1行NextshWindows("2.xls").Close'关闭对象文件Application.ScreenUpdating=TrueEndSub▲当前单元录入计算机名返回Sub当前单元录入计算机名()Selection=Environ("COMPUTERNAME")'Selection=Workbooks("临时表").Sheets("表2").Range("A1")调用指定地址内容EndSub▲当前单元录入计算机用户名返回Sub当前单元录入计算机用户名()Selection=Environ("Username")'Selection=Workbooks("临时表").Sheets("表2").Range("A1")调用指定地址内容EndSub▲解除全部工作表保护返回Sub解除全部工作表保护()DimnAsInteger   Forn=1ToSheets.Count       Sheets(n).Unprotect   NextnEndSub▲为指定工作表加指定密码保护表返回Sub为指定工作表加指定密码保护表()Sheet10.ProtectPassword:="123"EndSub▲在有密码的工作表执行代码返回Sub在有密码的工作表执行代码()Sheets("1").UnprotectPassword:=123'假定表名为“1”，密码为“123”打开工作表Range("C:C").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden=True'隐藏C列空值行Sheets("1").ProtectPassword:=123'重新用密码保护工作表EndSub▲执行前需要验证密码的宏(控件按钮代码)返回PrivateSubCommandButton1_Click()IfInputBox("请输入密码：")<>"123"Then'密码是123MsgBox"密码错误,按确定退出!",64,"提示"ExitSubEndIfCells(1,1)=10EndSubSub执行前需要验证密码的宏()IfInputBox("请输入您的使用权限:","系统提示")=123Then重排窗口'要执行的宏代码或宏名称ElseMsgBox"对不起,您没有使用该宏的权限,按确定键后退出!"EndIfEndSub▲拷贝A1公式和格式到A2返回Sub拷贝A1公式到A2()Workbooks("临时表").Sheets("表1").Range("A1").CopyWorkbooks("临时表").Sheets("表2").Range("A2").PasteSpecialEndSub▲复制单元数值返回Sub复制数值()s=Workbooks("book1").Sheets("Sheet1").Range("A1:A2")Workbooks("book2").Sheets("Sheet1").Range("A1:A2")=sEndSub▲插入数值条件格式返回Sub插入数值条件格式()Selection.FormatConditions.DeleteSelection.FormatConditions.AddType:=xlCellValue,Operator:=xlGreater,_Formula1:="70"Selection.FormatConditions(1).Interior.ColorIndex=45Selection.FormatConditions.AddType:=xlCellValue,Operator:=xlLess,_Formula1:="55"Selection.FormatConditions(2).Interior.ColorIndex=39Selection.FormatConditions.AddType:=xlCellValue,Operator:=xlGreater,_Formula1:="60"Selection.FormatConditions(3).Interior.ColorIndex=34EndSub▲插入透明批注返回Sub插入透明批注()Selection.AddCommentSelection.Comment.Visible=FalseDimXSAsWorksheetFori=1ToActiveSheet.Comments.CountActiveSheet.Comments(i).Text"透明批注"ActiveSheet.Comments(i).Shape.Fill.Visible=msoFalseNextEndSub▲添加文本返回Sub添加文本()Selection=Selection+"×"'不可在数字后添加文本'Selection=Workbooks("临时表").Sheets("表2").Range("A1")调用指定地址内容EndSub▲光标定位到指定工作表A列最后数据行下一单元返回Sub光标定位到指定工作表A列最后数据行下一单元()a=Sheets("数据库").[a65536].End(xlUp).RowSheets("数据库").SelectRange("A"&a+1).SelectEndSub▲定位选定单元格式相同的全部单元格返回Sub定位选定单元格式相同的全部单元格()DimFirstCellAsRange,FoundCellAsRangeDimAllCellsAsRangeWithApplication.FindFormat.Clear.NumberFormatLocal=Selection.NumberFormatLocal.HorizontalAlignment=Selection.HorizontalAlignment.VerticalAlignment=Selection.VerticalAlignment.WrapText=Selection.WrapText.Orientation=Selection.Orientation.AddIndent=Selection.AddIndent.IndentLevel=Selection.IndentLevel.ShrinkToFit=Selection.ShrinkToFit.MergeCells=Selection.MergeCells.Font.Name=Selection.Font.Name.Font.FontStyle=Selection.Font.FontStyle.Font.Size=Selection.Font.Size.Font.Strikethrough=Selection.Font.Strikethrough.Font.Subscript=Selection.Font.Subscript.Font.Underline=Selection.Font.Underline.Font.ColorIndex=Selection.Font.ColorIndex.Interior.ColorIndex=Selection.Interior.ColorIndex.Interior.Pattern=Selection.Interior.Pattern.Locked=Selection.Locked.FormulaHidden=Selection.FormulaHiddenEndWithSetFirstCell=ActiveSheet.UsedRange.Find(what:="",searchformat:=True)IfFirstCellIsNothingThenExitSubEndIfSetAllCells=FirstCellSetFoundCell=FirstCellDoSetFoundCell=ActiveSheet.UsedRange.Find(After:=FoundCell,what:="",searchformat:=True)IfFoundCellIsNothingThenExitDoSetAllCells=Union(FoundCell,AllCells)IfFoundCell.Address=FirstCell.AddressThenExitDoLoopAllCells.SelectEndSub▲按当前单元文本定位返回Sub按当前单元文本定位()ABC=SelectionDimaaAsRangeForEachaInActiveSheet.UsedRangeIfaLikeABCThenIfaaIsNothingThenSetaa=a.CellsElseSetaa=Union(aa,a.Cells)EndIfEndIfNextaa.SelectEndSub▲按固定文本定位返回Sub文本定位()DimaaAsRangeForEachaInActiveSheet.UsedRangeIfaLike"*合计*"ThenIfaaIsNothingThenSetaa=a.CellsElseSetaa=Union(aa,a.Cells)EndIfEndIfNextaa.SelectEndSub▲删除包含固定文本单元的行或列返回Sub删除包含固定文本单元的行或列()DoCells.Find(what:="哈哈").ActivateSelection.EntireRow.Delete'删除行'Selection.EntireColumn.Delete'删除列LoopUntilCells.Find(what:="哈哈")IsNothingEndSub▲定位数据及区域以上的空值返回Sub定位数据及区域以上的空值()DimaaAsRangeForEachaInActiveSheet.UsedRangeIfaLike〈0ThenIfaaIsNothingThenSetaa=a.CellsElseSetaa=Union(aa,a.Cells)EndIfEndIfNextaa.SelectEndSub▲右侧单元自动加5(工作表代码)返回PrivateSubWorksheet_Change(ByValTargetAsRange)Application.EnableEvents=FalseTarget.Offset(0,1)=Target+5Application.EnableEvents=TrueEndSub▲当前单元加2返回Sub当前单元加2()Selection=Selection+2'Selection=Workbooks("临时表").Sheets("表2").Range("A1")调用指定地址内容EndSub▲A列等于A列减B列返回SubA列等于A列减B列()Fori=1To23Cells(i,1)=Cells(i,1)-Cells(i,2)NextEndSub▲用于光标选定多区域跳转指定单元(工作表代码)返回PrivateSubWorksheet_SelectionChange(ByValTAsRange)a=Array([b6:b7],[e6],[h6])Fori=0To2IfNotApplication.Intersect(T,a(i))IsNothingThen[a1].Select:ExitForEndIfNextEndSub▲将A1单元录入的数据累加到B1单元（工作表代码）返回PrivateSubWorksheet_Change(ByValTargetAsRange)DimtAsLongIfTarget.Address="$A$1"Thent=Sheet1.Range("$B$1").ValueSheet1.Range("$B$1").Value=t+Target.ValueEndIfEndSub▲在指定颜色区域选择单元时添加/取消"√"（工作表代码）返回PrivateSubWorksheet_SelectionChange(ByValTargetAsRange)DimmyrgAsRangeForEachmyrgInTargetIfmyrg.Interior.ColorIndex=37Thenmyrg=IIf(myrg<>"√","√","")NextEndSub▲在指定区域选择单元时添加/取消"√"（工作表代码）返回PrivateSubWorksheet_SelectionChange(ByValTargetAsRange)DimRngAsRangeIfTarget.Count<=15ThenIfNotApplication.Intersect(Target,Range("D6:D20"))IsNothingThenForEachRngInSelectionWithRngIf.Value=""Then.Value="√"Else.Value=""EndIfEndWithNextEndIfEndIfEndSub▲双击指定单元，循环录入文本（工作表代码）返回PrivateSubWorksheet_BeforeDoubleClick(ByValTAsRange,CancelAsBoolean)IfT.Address<>"$A$1"ThenExitSubCancel=TrueT=IIf(T="好","中",IIf(T="中","差","好"))EndSub双击指定单元，循环录入文本（工作表代码）DimnumsAsBytePrivateSubWorksheet_BeforeDoubleClick(ByValTargetAsRange,CancelAsBoolean)IfTarget.Address="$A$1"Thennums=numsMod3+1Target=Mid("上中下",nums,1)Target.Offset(1,0).SelectEndIfEndSub▲单元区域引用（工作表代码）返回PrivateSubWorksheet_Activate()Sheet1.Range("A1:B3").Value=Sheet2.Range("A1:B3").ValueEndSub▲在指定区域选择单元时数值加1（工作表代码）返回PrivateSubWorksheet_SelectionChange(ByValTargetAsRange)IfNotApplication.Intersect([a1:e10],Target)IsNothingThenTarget=Val(Target)+1EndIfEndSub▲混合文本的编号返回Sub混合文本的编号()Worksheets(1).Range("B2").Value="北京"&(--(Mid(Worksheets(1).Range("B2"),3,100))+1)EndSub▲指定区域单元双击数据累加（工作表代码）返回PrivateSubWorksheet_BeforeDoubleClick(ByValTargetAsRange,CancelAsBoolean)IfNotApplication.Intersect([A1:Y100],Target)IsNothingThenold