《Excel常见宏(简洁版)》由会员分享，可在线阅读，更多相关《Excel常见宏(简洁版)（40页珍藏版）》请在金锄头文库上搜索。
1、清除剪贴板Sub 清除剪贴板()Application.CutCopyMode = FalseApplication.CommandBars(Task Pane).Visible = FalseEnd Sub批量清除软回车Sub 批量清除软回车()也可直接使用 Alt+10 或 13 替换Cells.Replace What:=Chr(10), Replacement:=, LookAt:=xlPart, SearchOrder:= _xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=FalseEnd Sub判断指定
2、文件是否已经打开Sub 判断指定文件是否已经打开()Dim x As IntegerFor x = 1 To Workbooks.CountIf Workbooks(x).Name = 函数.xls Then 文件名称MsgBox 文件已打开Exit SubEnd IfNextMsgBox 文件未打开End Sub当前文件另存到指定目录Sub 当前激活文件另存到指定目录()ActiveWorkbook.SaveAs Filename:=E:信件 & ActiveWorkbook.NameEnd Sub另存指定文件名Sub 另存指定文件名()ActiveWorkbook.SaveAs ThisW
3、orkbook.Path & 别名.xlsEnd Sub以本工作表名称另存文件到当前目录Sub 以本工作表名称另存文件到当前目录()ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & & ActiveSheet.Name & .xlsEnd Sub将本工作表单独另存文件到 Excel 当前默认目录Sub 将本工作表单独另存文件到 Excel 当前默认目录()ActiveSheet.CopyActiveWorkbook.SaveAs Filename:=ActiveSheet.Name & .xlsEnd Sub以活动工作表名称另存文件到 Ex
4、cel 当前默认目录Sub 以活动工作表名称另存文件到 Excel 当前默认目录()ActiveWorkbook.SaveAs Filename:=ActiveSheet.Name & .xls, FileFormat:= _xlNormal, Password:=, WriteResPassword:=, ReadOnlyRecommended:=False _, CreateBackup:=FalseEnd Sub另存所有工作表为工作簿Sub 另存所有工作表为工作簿()Dim sht As WorksheetApplication.ScreenUpdating = Falseipath =
5、 ThisWorkbook.Path & For Each sht In Sheetssht.CopyActiveWorkbook.SaveAs ipath & sht.Name & .xls (工作表名称为文件名） ActiveWorkbook.SaveAs ipath & sht.Name & Trim(sht.d15) & .xls （文件名称 & D15单元内容）ActiveWorkbook.SaveAs ipath & Trim(sht.d15) & .xls （文件名称为 D15 单元内容）ActiveWorkbook.CloseNextApplication.ScreenUpda
6、ting = TrueEnd Sub以指定单元内容为新文件名另存文件Sub 以指定单元内容为新文件名另存文件()ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & & Sheet1.A1End Sub以当前日期为新文件名另存文件Sub 以当前日期为新文件名另存文件()ThisWorkbook.SaveAs ThisWorkbook.Path & & Format(Now(), yyyymmdd) & .xlsEnd SubSub 以当前日期为名称另存文件()ActiveWorkbook.SaveAs Filename:=Date & .xlsEn
7、d Sub以当前日期和时间为新文件名另存文件Sub 以当前日期和时间为新文件名另存文件()ThisWorkbook.SaveAs ThisWorkbook.Path & & Format(Now(), yyyy & 年 & mm & 月 & dd & 日 & h & 时 & mm & 分 & ss & 秒) & .xlsEnd Sub另存本表为 TXT 文件Sub 另存本表为 TXT 文件()Dim s As StringDim FullName As String, rng As RangeApplication.ScreenUpdating = FalseFullName = (Activ
8、eSheet.Name & .txt) 以当前表名为 TXT 文件名 FullName = Replace(ThisWorkbook.FullName, .xls, .txt) 以当前文件名为 TXT 文件名 FullName = Replace(ThisWorkbook.FullName, .xls, ActiveSheet.Name & .txt) 以文件名&表名为 TXT 文件名Open FullName For Output As #1 以读写方式打开文件，每次写内容都会覆盖原先的内容参考帮助，fullname 为文件全名For Each rng In Range(a1).Curren
9、tRegions = s & IIf(s = , , |) & rng.ValueIf rng.Column = Range(a1).CurrentRegion.Columns.Count ThenPrint #1, s & | 把数据写到文本文件里s = End IfNextClose #1 关闭文件Application.ScreenUpdating = TrueMsgBox 数据已导入文本End Sub引用指定位置单元内容为部分文件名另存文件Sub 引用指定位置单元内容为部分文件名另存文件()ActiveWorkbook.SaveAs Filename:=E:信件 & 解答 & Rang
10、e(sheet1!a1) & 郎雀.xlsEnd Sub将 A 列数据排序到 D 列Sub 将 A 列数据排序到 D 列()d:d = a:a.Valued:d.Sort Key1:=Range(D1), Order1:=xlAscending, Header:=xlYesEnd Sub将指定范围的数据排列到 D 列Sub 将指定范围的数据排列到 D 列()Dim arr1, arr2, i%, xarr1 = Range(A1:C3)ReDim arr2(1 To UBound(arr1, 1) * UBound(arr1, 2), 1 To 1)For Each x In Applicat
11、ion.Transpose(arr1)i = i + 1arr2(i, 1) = xNext xRange(D1).Resize(i, 1) = arr2End Sub光标移动Sub 光标移动()ActiveCell.Offset(1, 2).Select 向下移动 1 行，向右移动 2 列End Sub光标所在行上移一行Sub 光标所在行上移一行()Dim i%i = Split(ActiveCell.Address, $)(2)If i 1 ThenRows(i).CutRows(i - 1).Insert Shift:=xlDownEnd IfEnd Sub加数据有效限制Sub 加数据有
12、效限制()With Selection.Validation.Delete.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _xlBetween, Formula1:=.IgnoreBlank = False.InCellDropdown = False.InputTitle = .ErrorTitle = .InputMessage = .ErrorMessage = 要奋斗就会有牺牲，死人的事是经常发生的。.IMEMode = xlIMEModeNoControl.ShowInput = True.Sho
13、wError = TrueEnd WithEnd Sub取消数据有效限制Sub 取消数据有效限制()With Selection.Validation.Delete.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _:=xlBetween.IgnoreBlank = False.InCellDropdown = False.InputTitle = .ErrorTitle = .InputMessage = .ErrorMessage = .IMEMode = xlIMEModeNoControl .S
14、howInput = True.ShowError = TrueEnd WithEnd Sub重排窗口Sub 重排窗口()Application.CommandBars(Web).Visible = FalseApplication.CommandBars(我的工具).Visible = FalseWindows.Arrange ArrangeStyle:=xlCascadeEnd Sub按当前单元文本选择打开指定文件单元Sub 选择打开文件单元()Dim aa = ActiveCell.ValueRange(a).Worksheet.ActivateRange(a).SelectEnd Su
15、b回车光标向右Sub 录入光标向右()Application.MoveAfterReturnDirection = xlToRightEnd Sub回车光标向下Sub 录入光标向下()Application.MoveAfterReturnDirection = xlDownEnd Sub保护工作表时取消选定锁定单元Sub 取消选定锁定单元()ActiveSheet.EnableSelection = xlUnlockedCells 用于 2000 版End Sub保存并退出 ExcelSub 保存并退出 Excel()Application.SendKeys (ENTERENTER%fx)ActiveWorkbook.SaveEnd Sub隐藏/显示指定列空值行Sub 隐藏显示 E 列空值行()Range(E1:E1000).SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = Not (Range(E1:E1000).SpecialCells(xlCellTypeBlanks).EntireRow.Hidden)End Sub深度隐藏指定工作表Sub 深度隐藏指定工作表()Sheets(用户名密码).Visi
