VBA程序开发-259个常用宏.xls

代代码码目目录录链链接接类类别别 打开全部隐藏工作表点击工作表 循循环环宏宏点击宏管理 录录制制宏宏时时调调用用 停停止止录录制制 工工具具栏栏点击其他 高高级级筛筛选选5 5列列不不重重复复数数据据至至指指定定表表点击筛选 双双击击单单元元执执行行宏宏 工工作作表表代代码码 点击宏管理 双双击击指指定定区区域域单单元元执执行行宏宏 工工作作表表代代码码 点击宏管理 进进入入单单元元执执行行宏宏 工工作作表表代代码码 点击宏管理 进进入入指指定定区区域域单单元元执执行行宏宏 工工作作表表代代码码 点击宏管理 在在多多个个宏宏中中依依次次循循环环执执行行一一个个 控控件件按按钮钮代代码码 点击宏管理 在在两两个个宏宏中中依依次次循循环环执执行行一一个个并并相相应应修修改改按按钮钮名名称称 控控件件按按钮钮代代码码 点击宏管理 在在三三个个宏宏中中依依次次循循环环执执行行一一个个并并相相应应修修改改按按钮钮名名称称 控控件件按按钮钮代代码码 点击宏管理 根根据据A1A1单单元元文文本本隐隐藏藏 显显示示按按钮钮 控控件件按按钮钮代代码码 点击控件 当当前前单单元元返返回回按按钮钮名名称称 控控件件按按钮钮代代码码 点击控件 当当前前单单元元内内容容返返回回到到按按钮钮名名称称 控控件件按按钮钮代代码码 点击控件 奇奇偶偶页页分分别别打打印印 点击打印 自自动动打打印印多多工工作作表表第第一一页页点击打印 查查找找A A列列文文本本循循环环插插入入分分页页符符点击打印 将将A A列列最最后后数数据据行行以以上上的的所所有有B B列列图图片片大大小小调调整整为为所所在在 单单元元大大小小 点击对象 返返回回光光标标所所在在行行数数点击查找和引用 在在A1A1返返回回当当前前选选中中单单元元格格数数量量点击查找和引用 返返回回当当前前工工作作簿簿中中工工作作表表数数量量点击查找和引用 返返回回光光标标选选择择区区域域的的行行数数和和列列数数点击查找和引用 工工作作表表中中包包含含数数据据的的最最大大行行数数点击查找和引用 返返回回A A列列数数据据的的最最大大行行数数点击查找和引用 将所选区域文本插入新建文本框点击对象 批量插入地址批注点击批注 批量插入统一批注点击批注 以A1单元内容批量插入批注点击批注 不连续区域插入当前文件名和表名及地址点击单元赋值 不连续区域录入当前单元地址点击单元赋值 连续区域录入当前单元地址点击单元赋值 返回当前单元地址点击单元赋值 不连续区域录入当前日期点击单元赋值 不连续区域录入当前数字日期点击单元赋值 不连续区域录入当前日期和时间点击单元赋值 不连续区域录入对勾点击单元赋值 不连续区域录入当前文件名点击单元赋值 不连续区域添加文本点击单元赋值 不连续区域插入文本点击单元赋值 从指定位置向下同时录入多单元指定内容点击单元赋值 按aa工作表A列的内容排列工作表标签顺序点击工作表 以A1单元文本作表名插入工作表点击工作表 登登录录 删除全部未选定工作表点击工作表 工作表标签排序点击工作表 定义指定工作表标签颜色点击工作表 在目录表建立本工作簿中各表链接目录点击文件管理 建立工作表文本目录点击工作表 查另一文件的全部表名点击工作表 当前单元录入计算机名点击单元赋值 当前单元录入计算机用户名点击单元赋值 解除全部工作表保护点击工作表 为指定工作表加指定密码保护表点击密码 在有密码的工作表执行代码点击密码 执行前需要验证密码的宏 控件按钮代码 点击密码 拷拷贝贝A1A1公公式式和和格格式式到到A2A2点击单元赋值 复复制制单单元元数数值值点击单元赋值 插入数值条件格式点击格式 插入透明批注点击批注 添加文本点击单元赋值 光光标标定定位位到到指指定定工工作作表表A A列列最最后后数数据据行行下下一一单单元元点击定位 定定位位选选定定单单元元格格式式相相同同的的全全部部单单元元格格点击定位 按按当当前前单单元元文文本本定定位位点击定位 按按固固定定文文本本定定位位点击定位 删删除除包包含含固固定定文文本本单单元元的的行行或或列列点击定位 定定位位数数据据及及区区域域以以上上的的空空值值点击定位 右右侧侧单单元元自自动动加加5 5 工工作作表表代代码码 点击单元赋值 当当前前单单元元加加2 2点击单元赋值 A A列列等等于于A A列列减减B B列列点击单元赋值 用用于于光光标标选选定定多多区区域域跳跳转转指指定定单单元元 工工作作表表代代码码 点击定位 将A1单元录入的数据累加到B1单元 工作表代码 点击单元赋值 在指定颜色区域选择单元时添加 取消 工作表代码 点击单元赋值 在指定区域选择单元时添加 取消 工作表代码 点击单元赋值 双击指定单元 循环录入文本 工作表代码 点击单元赋值 单元区域引用 工作表代码 点击单元赋值 在指定区域选择单元时数值加1 工作表代码 点击单元赋值 混合文本的编号点击单元赋值 指定区域单元双击数据累加 工作表代码 点击单元赋值 选择单元区域触发事件 工作表代码 点击事件 当修改指定单元内容时自动执行宏 工作表代码 点击事件 被指定单元内容限制执行宏点击事件 双击单元隐藏该行 工作表代码 点击事件 高亮显示行 工作表代码 点击其他 高亮显示行和列 工作表代码 点击其他 为指定工作表设置滚动范围 工作簿代码 点击定位 在指定单元记录打印和预览次数 工作簿代码 点击打印 自动数字金额转大写 工作表代码 点击单元赋值 将全部工作表的A1单元作为单击按钮 工作簿代码 点击对象 闹闹钟钟 到指定时间执行宏 工作簿代码 点击事件 改变Excel界面标题的宏 工作簿代码 点击其他 在在指指定定工工作作表表的的指指定定单单元元返返回回光光标标当当前前多多选选区区地地址址 工工作作簿簿代代码码 点击信息 B B列列录录入入数数据据时时在在A A列列返返回回记记录录时时间间 工工作作表表代代码码 点击事件 当当指指定定区区域域修修改改时时在在其其右右侧侧的的2 2个个单单元元返返回回当当前前日日期期和和 时时间间 工工作作表表代代码码 点击单元赋值 指指定定单单元元显显示示光光标标位位置置内内容容 工工作作表表代代码码 点击单元赋值 每编辑一个单元保存文件点击事件 指定允许编辑区域点击编辑 解除允许编辑区域限制点击编辑 删除指定行点击行列操作 删除A列为指定内容的行点击行列操作 删除A列非数字单元行点击行列操作 有条件删除当前行点击行列操作 选选择择下下一一行行点击定位 选选择择第第5 5行行开开始始所所有有数数据据行行点击定位 选选择择光光标标或或选选区区所所在在行行点击定位 选选择择光光标标或或选选区区所所在在列列点击定位 光光标标定定位位到到名名称称指指定定位位置置 点击名称 选选择择名名称称定定义义的的数数据据区区点击名称 选选择择到到指指定定列列的的最最后后行行点击定位 将Sheet1的A列的非空值写到Sheet2的A列点击单元赋值 将名称1的数据写到名称2点击名称 单元反选点击定位 调调整整选选中中对对象象中中的的文文字字点击格式 去去除除指指定定范范围围内内的的对对象象点击对象 更更新新透透视视表表数数据据项项点击数据 将将全全部部工工作作表表名名称称写写到到A A列列点击单元赋值 为为当当前前选选定定的的多多单单元元插插入入指指定定名名称称点击名称 删删除除全全部部名名称称点击名称 以以指指定定区区域域为为表表目目录录补补充充新新表表点击工作表 按按A A列列数数据据批批量量修修改改表表名名称称点击工作表 按按A A列列数数据据批批量量创创建建新新表表 控控件件按按钮钮代代码码 点击工作表 清除剪贴板点击其他 批量清除软回车点击其他 判断指定文件是否已经打开点击事件 当前文件另存到指定目录点击文件管理 另存指定文件名点击文件管理 以本工作表名称另存文件到当前目录点击文件管理 将本工作表单独另存文件到Excel当前默认目录点击文件管理 以活动工作表名称另存文件到Excel当前默认目录点击文件管理 另存所有工作表为工作簿点击文件管理 以指定单元内容为新文件名另存文件点击文件管理 以当前日期为新文件名另存文件点击文件管理 以当前日期和时间为新文件名另存文件点击文件管理 另另存存本本表表为为TXTTXT文文件件 点击文件管理 引用指定位置单元内容为部分文件名另存文件点击文件管理 将A列数据排序到D列点击单元赋值 将将指指定定范范围围的的数数据据排排列列到到D D列列点击单元赋值 光标移动点击定位 光标所在行上移一行点击行列操作 加数据有效限制点击数据 取消数据有效限制点击数据 重排窗口点击窗口 按当前单元文本选择打开指定文件单元点击定位 回车光标向右点击定位 回车光标向下点击定位 保护工作表时取消选定锁定单元点击工作表 保存并退出Excel点击文件管理 隐藏 显示指定列空值行点击行列操作 深度隐藏指定工作表点击工作表 隐藏指定工作表点击工作表 隐藏当前工作表点击工作表 返回当前工作表名称点击工作表 获取上一次所进入工作簿的工作表名称点击工作表 按光标选定颜色隐藏本列其他颜色行点击格式 打开工作簿自动隐藏录入表以外的其他表点击工作表 除最左边工作表外深度隐藏所有表点击工作表 关闭文件时自动隐藏指定工作表 ThisWorkbook 点击工作表 打开文件时提示指定工作表是保护状态 ThisWorkbook 点击工作表 插入10行点击行列操作 全选固定范围内小于0的单元点击定位 全选选定范围内小于0的单元点击定位 固固定定区区域域单单元元分分类类变变色色点击格式 A列半角内容变红点击格式 单元格录入数据时运行宏的代码点击事件 焦点到A列时运行宏的代码点击事件 根据B列最后数据快速合并A列单元格的控件代码点击数据 在F1单元显示光标位置批注内容的代码点击其他 显示光标所在单元的批注的代码点击其他 使使单单元元内内容容保保持持不不变变的的工工作作表表代代码码点击单元赋值 有有条条件件执执行行宏宏点击事件 有有条条件件执执行行不不同同的的宏宏点击事件 提提示示确确定定或或取取消消执执行行宏宏点击事件 提提示示开开始始和和结结束束点击事件 拷贝指定表不相邻多列数据到新位置点击单元赋值 选择2至4行点击定位 在当前选区有条件替换数值为文本点击事件 自动筛选全部显示指定列点击筛选 自动筛选第2列值为A的行点击筛选 取消自动筛选 点击筛选 全部显示指定表的自动筛选点击筛选 强行合并单元点击格式 设置单元区域格式点击格式 在所有工作表的A1单元返回顺序号点击单元赋值 根根据据A1A1单单元元内内容容返返回回C1C1数数值值点击事件 根根据据A1A1内内容容选选择择执执行行宏宏点击事件 删除A列空行点击行列操作 在在A A列列产产生生不不重重复复随随机机数数点击单元赋值 将将A A列列数数据据随随机机排排列列到到F F列列点击单元赋值 取取消消选选定定区区域域的的公公式式只只保保留留值值 假假空空转转真真空空 点击单元赋值 处理导入的显示为科学计数法样式的身份证号点击其他 返回指定单元的行高和列宽点击信息 指定行高和列宽点击格式 指定单元的行高和列宽与A1单元相同点击格式 填公式点击单元赋值 建立当前工作表的副本为001表点击工作表 在第一个表前插入多工作表点击工作表 清除A列再插入序号点击单元赋值 反方向文本 自定义函数 点击自定义函数 指定选择单元区域弹出消息点击信息 将B列数据添加超链接到K列点击超链接 删除B列数据的超链接点击超链接 分离临时表A列数据的文本和超链接并整理到数据库表 点击超链接 分离临时表A列数据的文本和超链接并会同其他数据整 理到数据库表 点击超链接 返返回回A A列列最最后后一一个个非非空空单单元元行行号号点击查找和引用 返回表中第一个非空单元地址 行搜索 点击查找和引用 返回表中各非空单元区域地址 行搜索 点击查找和引用 返回第一个数值行号点击查找和引用 返返回回第第1 1行行最最右右边边非非空空单单元元的的列列号号点击查找和引用 返返回回连连续续数数值值单单元元的的数数量量点击查找和引用 统统计计指指定定范范围围和和内内容容的的单单元元数数量量点击查找和引用 统统计计不不同同颜颜色色的的数数字字的的和和 自自定定义义函函数数 点击查找和引用 返回非空单元数量点击查找和引用 返回A列非空单元数量点击查找和引用 返回圆周率 点击其他 定义指定单元内容为页眉 页脚点击打印 提示并全部清除当前选择区域点击单元赋值 全部清除当前选择区域点击单元赋值 清除指定区域数值点击单元赋值 对指定工作表执行取消隐藏 打印 隐藏工作表点击打印 打开文件时执行指定宏 工作簿代码 点击事件 关闭文件时执行指定宏 工作簿代码 点击事件 弹出提示A1单元内容点击信息 延延时时1515秒秒执执行行重重排排窗窗口口宏宏点击事件 撤消工作表保护并取消密码点击工作表 重算指定表点击工作表 将第5行移到窗口的最上面点击窗口 对第一张工作表的指定区域进行排序点击单元赋值 显示指定工作表的打印预览点击打印 用单元格A1的内容作为文件名另存当前工作簿点击文件管理 禁用 启用 保存和另存的代码点击文件管理 在A和B列返回当前选区的名称和公式点击单元赋值 朗读朗读A列 按ESC键中止点击语音 朗读固定语句 请按ESC键终止点击语音 在M和N列的14行以下选择单元时显示调用日历控件 工作表代码 点击对象 添加自定义序列点击其他 弹出打印对话框点击打印 返回总页码点击打印 合并各工作表内容点击事件 合并指定目录中所有文件中相同格式工作表的数据点击事件 隐藏指定工作表的指定列点击工作表 把a列不重复值取到e列点击查找和引用 当前选区的行列数点击查找和引用 单元格录入1位字符就跳转 工作表代码 点击工作表 当指定日期 每月10日 打开文件执行宏点击事件 提示并清空单元区域点击事件 返回光标所在行号点击其他 VBA返回公式结果点击其他 按照当前行A列的图片名称插入图片到H列点击图片 当前行下插入1行点击工作表 取消指定行或列的隐藏点击工作表 复制单元格所在行点击其他 复制单元格所在列点击其他 新建一个工作表点击工作表 新建一个工作簿点击工作簿 选择多表为工作组点击工作表 在当前工作组各表中分别执行指定宏点击事件 复制当前工作簿的报表到临时工作簿点击工作簿 删除指定文件点击工作簿 合并A1至C1的内容写到D15单元的批注中点击批注 自动重算点击其他 手动重算点击其他 帖子地址 8 89 宏宏文文件件集集 打打开开全全部部隐隐藏藏工工作作表表返回 Sub 打开全部隐藏工作表 Dim i As Integer For i 1 To Sheets Count Sheets i Visible True Next i End Sub 循循环环宏宏返回 Sub 循环 AAA Range C2 Dim i As Long Dim times As Long times AAA times代表循环次数 执行前把times赋值即可 不可小于1 不可大于2147483647 For i 1 To times Call 过滤一行 If Range 完成标志 完成 Then Exit For 如果名为 完成标志 的命名单元的值等于 完成 则退出循环 如果一开始就等于 完成 则只执行一次循环就退出 If Sheets 传送参数 Range A i Text 完成 Then Exit For 如果某列出现 完成 内容则退出循环 Next i End Sub 录录制制宏宏时时调调用用 停停止止录录制制 工工具具栏栏返回 Sub 录制宏时调用停止录制工具栏 Application CommandBars Stop Recording Visible True End Sub 高高级级筛筛选选5 5列列不不重重复复数数据据至至指指定定表表返回 Sub 高级筛选5列不重复数据至Sheet2 Sheets Sheet2 Range A1 E65536 清除Sheet2的A D列 Range A1 E65536 AdvancedFilter Action xlFilterCopy CopyToRange Sheet2 Range 9 89 A1 Unique True Sheet2 Columns A E Sort Key1 Sheet2 Range A2 Order1 xlAscending Header xlGuess OrderCustom 1 MatchCase False Orientation xlTopToBottom SortMethod xlPinYin End 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 Cancel True End Select End 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 进进入入单单元元执执行行宏宏 工工作作表表代代码码 返回 Private Sub Worksheet SelectionChange ByVal Target As Range 以单元格进入代替按钮对象调用宏 10 89 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 Select End Sub 进进入入指指定定区区域域单单元元执执行行宏宏 工工作作表表代代码码 返回 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 Static RunMacro As Integer Select Case RunMacro Case 0 宏1 RunMacro 1 Case 1 宏2 RunMacro 2 Case 2 宏3 RunMacro 0 End Select End Sub 在在两两个个宏宏中中依依次次循循环环执执行行一一个个并并相相应应修修改改按按钮钮名名称称 控控件件按按钮钮代代码码 返回 11 89 Private Sub CommandButton1 1 Click With CommandButton1 1 If Caption 保护工作表 Then Call 保护工作表 Caption 取消工作表保护 Exit Sub End If If Caption 取消工作表保护 Then Call 取消工作表保护 Caption 保护工作表 Exit Sub End If End With End Sub 在在三三个个宏宏中中依依次次循循环环执执行行一一个个并并相相应应修修改改按按钮钮名名称称 控控件件按按钮钮代代码码 返回 Option Explicit Private Sub CommandButton1 1 Click With CommandButton1 1 If Caption 宏1 Then Call 宏1 Caption 宏2 Exit Sub End If If Caption 宏2 Then Call 宏2 Caption 宏3 Exit Sub End If If Caption 宏3 Then Call 宏3 Caption 宏1 Exit Sub End If 12 89 End With End Sub 根根据据A1A1单单元元文文本本隐隐藏藏 显显示示按按钮钮 控控件件按按钮钮代代码码 返回 Private Sub Worksheet SelectionChange ByVal Target As Range If Range A1 2 Then CommandButton1 Visible 1 Else CommandButton1 Visible 0 End If End Sub Private Sub CommandButton1 Click 重排窗口 End Sub 当当前前单单元元返返回回按按钮钮名名称称 控控件件按按钮钮代代码码 返回 Private Sub CommandButton1 Click ActiveCell CommandButton1 Caption End Sub 当当前前单单元元内内容容返返回回到到按按钮钮名名称称 控控件件按按钮钮代代码码 返回 Private Sub CommandButton1 Click CommandButton1 Caption ActiveCell End Sub 奇奇偶偶页页分分别别打打印印返回 Sub 奇偶页分别打印 Dim i Ps Ps ExecuteExcel4Macro GET DOCUMENT 50 总页数 MsgBox 现在打印奇数页 按确定开始 For i 1 To Ps Step 2 ActiveSheet PrintOut from i To i 13 89 Next i MsgBox 现在打印偶数页 按确定开始 For i 2 To Ps Step 2 ActiveSheet PrintOut from i To i Next i End Sub 自自动动打打印印多多工工作作表表第第一一页页返回 Sub 自动打印多工作表第一页 Dim sh As Integer Dim x Dim y Dim sy Dim syz x InputBox 请输入起始工作表名字 sy InputBox 请输入结束工作表名字 y Sheets x Index syz Sheets sy Index For sh y To syz Sheets sh Select Sheets sh PrintOut from 1 To 1 Next sh End Sub 查查找找A A列列文文本本循循环环插插入入分分页页符符返回 SubSub 循循环环插插入入分分页页符符 SelectionSelection Workbooks Workbooks 临临时时表表 Sheets Sheets 表表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 分分页页 times times代代表表循循环环次次数数 执执行行前前把把timestimes赋赋值值即即可可 不不可可小小于于1 1 不不可可大大于于2147483647 2147483647 ForFor i i 1 1 ToTo timestimes CallCall 插插入入分分页页符符 14 89 NextNext i i EndEnd SubSub SubSub 插插入入分分页页符符 Cells Find What Cells Find What 分分页页 After ActiveCell After ActiveCell LookIn xlValues LookIn xlValues LookAt LookAt xlPart xlPart SearchOrder xlByRows SearchOrder xlByRows SearchDirection xlNext SearchDirection xlNext MatchCase False MatchCase False Activate Activate ActiveWindow SelectedSheets HPageBreaks AddActiveWindow SelectedSheets HPageBreaks Add Before ActiveCellBefore ActiveCell EndEnd SubSub Sub 取消原分页 Cells Select ActiveSheet ResetAllPageBreaks End 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 Pic TopLeftCell Left Pic Height Pic TopLeftCell Height Pic Width Pic TopLeftCell Width End If Next End Sub 返返回回光光标标所所在在行行数数返回 Sub 返回光标所在行数 x ActiveCell Row Range A1 x End Sub 15 89 在在A1A1返返回回当当前前选选中中单单元元格格数数量量返回 Sub 在A1返回当前选中单元格数量 A1 Selection Count End Sub 返返回回当当前前工工作作簿簿中中工工作作表表数数量量返回 Sub 返回当前工作簿中工作表数量 t Application Sheets Count MsgBox t End Sub 返返回回光光标标选选择择区区域域的的行行数数和和列列数数返回 Sub 返回光标选择区域的行数和列数 x Selection Rows Count y Selection Columns Count Range A1 x Range A2 y End Sub 工工作作表表中中包包含含数数据据的的最最大大行行数数返回 Sub 包含数据的最大行数 n Cells Find 1 2 Row MsgBox n End Sub 返返回回A A列列数数据据的的最最大大行行数数返回 Sub 返回A列数据的最大行数 n Range a65536 End xlUp Row Range B1 n End Sub 将将所所选选区区域域文文本本插插入入新新建建文文本本框框返回 Sub 将所选区域文本插入新建文本框 16 89 For Each rag In Selection n n rag Value Chr 10 Next ActiveSheet Shapes AddTextbox msoTextOrientationHorizontal ActiveCell Left ActiveCell Width ActiveCell Top ActiveCell Height 250 100 Select Selection Characters Text 问题 n With Selection Characters Start 1 Length 3 Font Name 黑体 FontStyle 常规 Size 12 End With End Sub 批批量量插插入入地地址址批批注注返回 Sub 批量插入地址批注 On Error Resume Next Dim r As Range If Selection Cells Count 0 Then For Each r In Selection r Comment Delete r AddComment r Comment Visible False r Comment Text Text 本单元格 r Address of Selection Address Next End If End Sub 批批量量插插入入统统一一批批注注返回 Sub 批量插入统一批注 Dim r As Range msg As String msg InputBox 请输入欲批量插入的批注 提示 随便输点什么吧 If Selection Cells Count 0 Then For Each r In Selection r AddComment r Comment Visible False 17 89 r Comment Text Text msg Next End If End Sub 以以A1A1单单元元内内容容批批量量插插入入批批注注返回 Sub 以A1单元内容批量插入批注 Dim r As Range If Selection Cells Count 0 Then For Each r In Selection r AddComment r Comment Visible False r Comment Text Text a1 Text Next End If End Sub 不不连连续续区区域域插插入入当当前前文文件件名名和和表表名名及及地地址址返回 Sub 批量插入当前文件名和表名及地址 For Each mycell In Selection mycell FormulaR1C1 ActiveWorkbook Name ActiveSheet Name mycell Address Next End Sub 不不连连续续区区域域录录入入当当前前单单元元地地址址返回 Sub 区域录入当前单元地址 For Each mycell In Selection mycell FormulaR1C1 mycell Address Next End Sub 连连续续区区域域录录入入当当前前单单元元地地址址返回 Sub 连续区域录入当前单元地址 Selection ADDRESS ROW COLUMN 4 1 18 89 Selection Copy Selection PasteSpecial Paste xlPasteValues Operation xlNone SkipBlanks False Transpose False End Sub 返返回回当当前前单单元元地地址址返回 Sub 返回当前单元地址 d ActiveCell Address A1 d End Sub 不不连连续续区区域域录录入入当当前前日日期期返回 Sub 区域录入当前日期 Selection FormulaR1C1 Format Now yyyy m d End Sub 不不连连续续区区域域录录入入当当前前数数字字日日期期返回 Sub 区域录入当前数字日期 Selection 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 批量录入当前文件名 Selection FormulaR1C1 ThisWorkbook Name 19 89 End Sub 不不连连续续区区域域添添加加文文本本返回 Sub 批量添加文本 Dim s As Range For Each s In Selection s s 文本内容 Next End Sub 不不连连续续区区域域插插入入文文本本返回 Sub 批量插入文本 Dim s As Range For Each s In Selection s 文本内容 s Next End Sub 从从指指定定位位置置向向下下同同时时录录入入多多单单元元指指定定内内容容返回 Sub 从指定位置向下同时录入多单元指定内容 Dim arr arr Array 1 2 13 25 46 12 0 20 B2 Resize 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 Sheets str1 Select 20 89 Sheets str1 Move after Sheets I I I 1 Sheets aa Select Loop End Sub 以以A1A1单单元元文文本本作作表表名名插插入入工工作作表表返回 Sub 以A1单元文本作表名插入工作表 Dim nm As String nm a1 Sheets Add ActiveSheet Name nm End 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 For 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 For End If 21 89 Next If Not iFlag Then sht Delete Next Application DisplayAlerts True End Sub 工工作作表表标标签签排排序序返回 Sub 工作表标签排序 Dim i As Long j As Long nums As Long msg As Long msg MsgBox 工作表按升序排列请选 是 Y vbCrLf vbCrLf 工作表按降序排列请选 否 N vbYesNoCancel 工作表排序 If msg vbCancel Then Exit Sub nums 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 Name Then Sheets j Move Before Sheets i End If Next j Next i End If End Sub 22 89 定定义义指指定定工工作作表表标标签签颜颜色色返回 Sub 定义指定工作表标签颜色 Sheets Sheet1 Tab ColorIndex 46 End Sub 在在目目录录表表建建立立本本工工作作簿簿中中各各表表链链接接目目录录返回 Sub 在目录表建立本工作簿中各表链接目录 Dim s Rng As Range On Error Resume Next Sheets 目录 Activate If Err 0 Then Sheets 目录 UsedRange Delete Else Sheets Add ActiveSheet Name 目录 End If For i 1 To Sheets Count If Sheets i Name 目录 Then s s 1 Set Rng Sheets 目录 Cells s 1 Mod 20 1 s 1 20 1 1 Rng Format s 0 Sheets i Name ActiveSheet Hyperlinks Add Rng Sheets i Name A1 ScreenTip Sheets i Name End If Next Sheets 目录 Range b iv EntireColumn ColumnWidth 20 End Sub 建建立立工工作作表表文文本本目目录录返回 Sub 建立工作表文本目录 Sheets Add before Sheets 1 Sheets 1 Name 目录 23 89 For i 2 To Sheets Count Cells i 1 1 Sheets i Name Sheets 1 Hyperlinks Add Cells i 1 1 Sheets i Name A1 添加超链接 Next End Sub 查查另另一一文文件件的的全全部部表表名名返回 Sub 查另一文件的全部表名 On Error Resume Next Dim i Dim sh As Worksheet Application ScreenUpdating False Workbooks Open Filename ThisWorkbook Path 2 xls Windows Windows 1 xls1 xls Activate Activate 当前文件名称 Sheets Sheets Sheet1Sheet1 Select Select 当前表名称 i 1 1 将表名称返回到第1行 For Each sh In Workbooks 2 xls Worksheets Cells i 1 1 sh Name 将表名称返回到第1列 i i 1 1 返回每个表名称向下移动1行 Next sh Windows 2 xls CloseWindows 2 xls Close 关闭对象文件 Application ScreenUpdatingApplication ScreenUpdating TrueTrue End Sub 当当前前单单元元录录入入计计算算机机名名返回 Sub 当前单元录入计算机名 Selection Environ COMPUTERNAME Selection Workbooks 临时表 Sheets 表2 Range A1 调用指定地址内容 End Sub 当当前前单单元元录录入入计计算算机机用用户户名名返回 24 89 Sub 当前单元录入计算机用户名 Selection Environ Username Selection Workbooks 临时表 Sheets 表2 Range A1 调用指定地址内容 End Sub 解解除除全全部部工工作作表表保保护护返回 Sub 解除全部工作表保护 Dim n As Integer For n 1 To Sheets Count Sheets n Unprotect Next n End Sub 为为指指定定工工作作表表加加指指定定密密码码保保护护表表返回 Sub 为指定工作表加指定密码保护表 Sheet10 Protect Password 123 End Sub 在在有有密密码码的的工工作作表表执执行行代代码码返回 Sub 在有密码的工作表执行代码 Sheets 1 Unprotect Password 123 假定表名为 1 密码为 123 打开工作表 Range C C SpecialCells xlCellTypeBlanks EntireRow Hidden True 隐藏C列空值行 Sheets 1 Protect Password 123 重新用密码保护工作表 End Sub 执执行行前前需需要要验验证证密密码码的的宏宏 控控件件按按钮钮代代码码 返回 PrivatePrivate SubSub CommandButton1 Click CommandButton1 Click IfIf InputBox InputBox 请请输输入入密密码码 123 123 ThenThen 密密码码是是123123 MsgBoxMsgBox 密密码码错错误误 按按确确定定退退出出 64 64 提提示示 ExitExit SubSub EndEnd IfIf Cells 1 Cells 1 1 1 1010 EndEnd SubSub 25 89 SubSub 执执行行前前需需要要验验证证密密码码的的宏宏 IfIf InputBox InputBox 请请输输入入您您的的使使用用权权限限 系系统统提提示示 123123 ThenThen 重重排排窗窗口口 要要执执行行的的宏宏代代码码或或宏宏名名称称 ElseElse MsgBoxMsgBox 对对不不起起 您您没没有有使使用用该该宏宏的的权权限限 按按确确定定键键后后退退出出 EndEnd IfIf EndEnd SubSub 拷拷贝贝A1A1公公式式和和格格式式到到A2A2返回 Sub 拷贝A1公式到A2 Workbooks 临时表 Sheets 表1 Range A1 Copy Workbooks 临时表 Sheets 表2 Range A2 PasteSpecial End Sub 复复制制单单元元数数值值返回 Sub 复制数值 s Workbooks book1 Sheets Sheet1 Range A1 A2 Workbooks book2 Sheets Sheet1