excel常见宏命令

1、清除剪贴板Sub 清除剪贴板() Application.CutCopyMode = False Application.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 Integer For x = 1 To Workbooks.Count If Workbooks(x).Name = 函数.xls Then 文件名称 MsgBox 文件已打开 Exit Sub End If Next MsgBox 文件未打开End Sub当前文件另存到指定目录Sub 当前激活文件另存到指定目录()ActiveWorkbook.SaveAs Filename:=E:信件 & ActiveWorkbook.NameEnd Sub另存指定文件名Sub 另存指定文件名()ActiveWorkbook.Save

3、As ThisWorkbook.Path & 别名.xlsEnd Sub以本工作表名称另存文件到当前目录Sub 以本工作表名称另存文件到当前目录()ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & & ActiveSheet.Name & .xlsEnd Sub将本工作表单独另存文件到Excel当前默认目录Sub 将本工作表单独另存文件到Excel当前默认目录()ActiveSheet.Copy ActiveWorkbook.SaveAs Filename:=ActiveSheet.Name & .xlsEnd Sub以活动工作表名称另存文

4、件到Excel当前默认目录Sub 以活动工作表名称另存文件到Excel当前默认目录() ActiveWorkbook.SaveAs Filename:=ActiveSheet.Name & .xls, FileFormat:= _ xlNormal, Password:=, WriteResPassword:=, ReadOnlyRecommended:=False _ , CreateBackup:=FalseEnd Sub另存所有工作表为工作簿Sub 另存所有工作表为工作簿()Dim sht As WorksheetApplication.ScreenUpdating = Falseipa

5、th = ThisWorkbook.Path & For Each sht In Sheets sht.Copy ActiveWorkbook.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.Scre

6、enUpdating = 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 &

7、.xlsEnd Sub以当前日期和时间为新文件名另存文件Sub 以当前日期和时间为新文件名另存文件()ThisWorkbook.SaveAs ThisWorkbook.Path & & Format(Now(), yyyy & 年 & mm & 月 & dd & 日 & h & 时 & mm & 分 & ss & 秒) & .xlsEnd Sub另存本表为TXT文件Sub 另存本表为TXT文件() Dim s As String Dim FullName As String, rng As Range Application.ScreenUpdating = False FullName =

8、(ActiveSheet.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).Curr

9、entRegion s = s & IIf(s = , , |) & rng.Value If rng.Column = Range(a1).CurrentRegion.Columns.Count Then Print #1, s & | 把数据写到文本文件里 s = End If Next Close #1 关闭文件 Application.ScreenUpdating = True MsgBox 数据已导入文本End Sub引用指定位置单元内容为部分文件名另存文件Sub 引用指定位置单元内容为部分文件名另存文件()ActiveWorkbook.SaveAs Filename:=E:信件 &

10、 解答 & Range(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 Applicatio

11、n.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 Then Rows(i).Cut Rows(i - 1).Insert Shift:=xlDown End IfEnd Sub加数据有效限制Sub 加数据有

12、效限制() With Selection.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:=bigsun010 .IgnoreBlank = False .InCellDropdown = False .InputTitle = .ErrorTitle = .InputMessage = .ErrorMessage = 要奋斗就会有牺牲，死人的事是经常发生的。 .IMEMode = xlIMEModeNoControl .Sh

13、owInput = True .ShowError = True End WithEnd Sub取消数据有效限制Sub 取消数据有效限制() With Selection.Validation .Delete .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _ :=xlBetween .IgnoreBlank = False .InCellDropdown = False .InputTitle = .ErrorTitle = .InputMessage = .ErrorMessage = .IMEM

14、ode = xlIMEModeNoControl .ShowInput = True .ShowError = True End WithEnd Sub重排窗口Sub 重排窗口() Application.CommandBars(Web).Visible = False Application.CommandBars(我的工具).Visible = False Windows.Arrange ArrangeStyle:=xlCascadeEnd Sub按当前单元文本选择打开指定文件单元Sub 选择打开文件单元() Dim a a = ActiveCell.Value Range(a).Work

15、sheet.Activate Range(a).SelectEnd Sub回车光标向右Sub 录入光标向右() Application.MoveAfterReturnDirection = xlToRightEnd Sub回车光标向下Sub 录入光标向下() Application.MoveAfterReturnDirection = xlDownEnd Sub保护工作表时取消选定锁定单元Sub 取消选定锁定单元() ActiveSheet.EnableSelection = xlUnlockedCells 用于2000版End Sub保存并退出ExcelSub 保存并退出Excel()App

16、lication.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(用户名密码).Visible = xlVeryHiddenEnd Sub隐藏指定工作

17、表Sub 隐藏指定工作表()Sheets(用户名密码).Visible = falseEnd Sub隐藏当前工作表Sub 隐藏当前工作表() ActiveWindow.SelectedSheets.Visible = falseEnd Sub返回当前工作表名称Sub 返回当前工作表名称()wsName = ActiveSheet.NameMsgBox 当前工作表为： & wsNameEnd Sub获取上一次所进入工作簿的工作表名称Sub 获取上一次所进入工作簿的工作表名称()MsgBox Workbooks(2).ActiveSheet.NameEnd Sub按光标选定颜色隐藏本列其他颜色行S

18、ub 按颜色筛选() 思路就是:其它背景色之行全部隐藏Dim UseRow, AC, i 首先选择一个有颜色之单元格，然后动行宏，其它颜色所在行隐藏UseRow = Cells.SpecialCells(xlCellTypeLastCell).Row SpecialCells(xlCellTypeLastCell)表示已用区域最后一个单元格If ActiveCell.Row UseRow ThenMsgBox 请在要筛选的区域选择一个有颜色之单元格！, vbExclamation, 错误ElseAC = ActiveCell.ColumnCells.EntireRow.Hidden = Fal

19、se 显示所有行For i = 2 To UseRowIf Cells(i, AC).Interior.ColorIndex ActiveCell.Interior.ColorIndex ThenCells(i, AC).EntireRow.Hidden = True 如果2至已用行之单元格的有列之颜色不等于当前单元格颜色则隐藏整行End IfNextEnd IfEnd Sub打开工作簿自动隐藏录入表以外的其他表Private Sub Workbook_Open()Dim iFor i = 1 To Sheets.CountIf Sheets(i).Name 录入 ThenSheets(i).

20、Visible = FalseEnd IfNextEnd Sub除最左边工作表外深度隐藏所有表Sub 除最左边工作表外深度隐藏所有表()For i = 2 To ThisWorkbook.Sheets.Count Sheets(i).Visible = xlSheetVeryHiddenNextEnd Sub关闭文件时自动隐藏指定工作表(ThisWorkbook)Private Sub Workbook_BeforeClose(Cancel As Boolean)ActiveWorkbook.Unprotect Sheets(Sheet2).Visible = False Sheets(She

21、et3).Visible = FalseActiveWorkbook.Protect Structure:=True, Windows:=FalseEnd Sub打开文件时提示指定工作表是保护状态(ThisWorkbook)Private Sub Workbook_Open()If Worksheets(Sheet1).ProtectContents = True Then MsgBox Sheet1 保护了.End IfEnd Sub插入10行Sub 插入10行() Rows(ActiveCell.Row & : & ActiveCell.Row + 9).Select Selection.

22、Insert Shift:=xlDownEnd Sub全选固定范围内小于0的单元Sub 全选固定范围内小于0的单元()Dim rng As RangeDim yvhfFor Each rng In Range(d6: i18)If rng 0 Thenyvhf = yvhf & rng.Address & ,End IfNextRange(Left(yvhf, Len(yvhf) - 1).SelectEnd Sub全选选定范围内小于0的单元Sub 全选选定范围内小于0的单元()Dim rng As RangeDim yvhfFor Each rng In SelectionIf rng 0

23、Thenyvhf = yvhf & rng.Address & ,End IfNextRange(Left(yvhf, Len(yvhf) - 1).SelectEnd Sub固定区域单元分类变色Sub 单元分类变色()Dim rng As RangeFor Each rng In Range(d6: i18)If rng 0 Thenrng.Interior.ColorIndex = 3 文本、假空和大于0的单元变红底色End IfNextFor Each rng In Range(d6: i18)If rng = 0 Thenrng.Interior.ColorIndex = 2 空值和等

24、于0的单元变白底色End IfNextEnd SubA列半角内容变红Sub A列半角内容变红()Dim rg As Range, i As LongApplication.ScreenUpdating = FalseFor Each rg In Cells.SpecialCells(xlCellTypeConstants, 3) For i = 1 To Len(rg) If Asc(Mid(rg, i, 1) 0 Then rg.Characters(i).Font.ColorIndex = 3 NextNextApplication.ScreenUpdating = TrueEnd Sub

25、单元格录入数据时运行宏的代码Private Sub Worksheet_Change(ByVal Target As Range)重排窗口End Sub焦点到A列时运行宏的代码Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Column = 1 Then宏名 End IfEnd Sub根据B列最后数据快速合并A列单元格的控件代码Private Sub CommandButton1_Click()For i = 1 To b65536.End(xlUp).RowFor j = i + 1 To b655

26、36.End(xlUp).RowIf Range(a & j) = Then Range(a & i & :a & j).Merge Else Exit ForEnd IfNext jNext iEnd Sub在F1单元显示光标位置批注内容的代码Private Sub Worksheet_SelectionChange(ByVal Target As Range)a = Selection.Addressb = Range(a).NoteTextCells(1, 6) = bEnd Sub显示光标所在单元的批注的代码Dim r As RangePrivate Sub Worksheet_Sel

27、ectionChange(ByVal Target As Range)On Error Resume Nextr.Comment.Visible = FalseSet r = Targetr.Comment.Visible = TrueEnd Sub使单元内容保持不变的工作表代码Private Sub Worksheet_Change(ByVal Target As Range)B2 = 不可更改的数据End Sub有条件执行宏Sub 高级筛选()If J1 = 2 Or K1 = 筛选 Then Columns(D:E).Select Selection.Clear Range(D1).Se

28、lect Columns(A:B).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ G1:G2), CopyToRange:=Range(D1), Unique:=FalseEnd IfEnd Sub有条件执行不同的宏Sub 有条件执行不同的宏()If b1.Value = A ThenApplication.Run 宏1ElseIf b1.Value = B ThenApplication.Run 宏2End IfEnd Sub提示确定或取消执行宏Sub 提示确定或取消执行宏()If vbOK = MsgBox(确定要

29、复制吗?, vbOKCancel) ThenRange(A4:A14).Copy Range(b4:b14)Msgbox 复制结束End IfEnd Sub提示开始和结束Sub 提示结束()Msgbox 运行开始过程Msgbox 运行结束End Sub拷贝指定表不相邻多列数据到新位置Sub 拷贝指定表不相邻多列数据到新位置()Sheets(sheet1).Range(A:A,J:J).Copy Range(d1)End Sub选择2至4行Sub 选择2至4行() Dim a As Integer Dim b As Integer a = 2 b = 4 Rows(a & : & b).Sele

30、ctEnd Sub在当前选区有条件替换数值为文本Sub 在当前选区有条件替换数值为文本()For Each r In Selection If r.Value 18 And r.Value 29.5 Then r.Value = YNextEnd Sub自动筛选全部显示指定列Sub 自动筛选全部显示指定列()Selection.AutoFilter Field:=1Selection.AutoFilter Field:=2Selection.AutoFilter Field:=3Selection.AutoFilter Field:=4Selection.AutoFilter Field:=5

31、Selection.AutoFilter Field:=6End Sub自动筛选第2列值为A的行Sub 自动筛选第2列值为A的行()a1.AutoFilter 2, aEnd Sub取消自动筛选()Sub 取消自动筛选()ActiveSheet.AutoFilterMode = FalseEnd Sub全部显示指定表的自动筛选Sub 全部显示指定表的自动筛选()If Sheet1.FilterMode = True Then Sheet1.ShowAllDataEnd IfEnd Sub强行合并单元Sub 强行合并单元()Application.DisplayAlerts = False 不出

32、现对话框，按对话框默认选择Range(a3:a4).MergeApplication.ScreenUpdating = TrueEnd Sub设置单元区域格式Sub 设置单元区域格式()a:a.NumberFormat = yyyy.mm.ddSheet2.B:B.NumberFormatLocal = yyyy-m-dSheet2.C:C.NumberFormatLocal = G/通用格式End Sub在所有工作表的A1单元返回顺序号Sub 在所有工作表的A1单元返回顺序号()For i = 1 To Sheets.CountSheets(i).Cells(1, 1) = & Applic

33、ation.WorksheetFunction.Text(0 + i, 000)NextEnd Sub根据A1单元内容返回C1数值Sub 根据A1单元内容返回C1数值()If Range(A1) = A Then Range(C1).FormulaR1C1 = 结算 ElseIf Range(A1) = B Then Range(C1).FormulaR1C1 = 合计 ElseIf Range(A1) = C Then Range(C1).FormulaR1C1 = 部门 End IfEnd Sub根据A1内容选择执行宏Sub 根据A1内容选择执行宏() Select Case Sheet1

34、.A1 Case A 宏1 Case B 宏2 Case C 宏3 Case Else End SelectEnd Sub删除A列空行Sub 删除A列空行()Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.DeleteEnd Sub在A列产生不重复随机数Sub 在A列产生不重复随机数()Randomize TimerDim c(100) As ByteFor i = 1 To 100 产生100个随机数c(i) = iNextk = 100Do While l 100r = Int(Rnd() * k) + 1 随机数的范围aa = c(

35、r)c(r) = c(k)c(k) = aak = k - 1l = l + 1Cells(l, 1) = aaLoopEnd Sub将A列数据随机排列到F列Sub 将A列数据随机排列到F列()Dim n As Longn = a65536.End(xlUp).Rowf1.Resize(n, 1) = a1.Resize(n, 1).Valueg1.Resize(n, 1) = =rand()f:g.Sort g1g:g = End Sub取消选定区域的公式只保留值(假空转真空)Sub 取消选定区域的公式只保留值() Sheets(数据归并集中).Select 指定工作表 Columns(Q:

36、R).Select 指定范围Selection.Value = Selection.ValueEnd Sub处理导入的显示为科学计数法样式的身份证号Sub 处理导入的显示为科学计数法样式的身份证号()Selection.Value = Selection.FormulaEnd Sub返回指定单元的行高和列宽Sub 返回指定单元的行高和列宽()c2 = Range(A1).ColumnWidth 列宽b2 = Range(A1).RowHeight 行高End SubSub 返回指定单元的行高和列宽() Dim r%, c% r = a1.RowHeight c = a1.ColumnWidth

37、 b2 = r 行高 c2 = c 列宽End Sub指定行高和列宽Sub 指定行高和列宽()Range(A1:F1).ColumnWidth = 10 指定列宽Range(A2:A10).RowHeight = 40 指定行高End SubSub 指定行高和列宽()Columns(A:F).ColumnWidth = 10 指定列宽Rows(2:10).RowHeight = 40 指定行高End Sub指定单元的行高和列宽与A1单元相同Sub 指定单元的行高和列宽与A1单元相同()Range(A1:F1).ColumnWidth = Range(A1).ColumnWidth 指定列宽Ra

38、nge(A2:A10).RowHeight = Range(A1).RowHeight 指定行高End Sub填公式Sub 填公式()Range(C2:C12).Value = =SUM(A2:B2)End Sub建立当前工作表的副本为001表Sub 建立当前工作表的副本为001表() ActiveSheet.Copy Before:=Sheets(1) ActiveSheet.Name = 001End Sub在第一个表前插入多工作表Sub 在第一个表前插入多工作表()Sheets(1).SelectFor I = 1 To 50Sheets.Add.Name = 新表 & INextEnd

39、 Sub清除A列再插入序号Sub 清除A列再插入序号()Columns(1).ClearContents 清除A列内容For i = 1 To 20Range(a & i) = iNextEnd Sub反方向文本(自定义函数)Function zhyz(zhyz1 As Range)zhyz = StrReverse(zhyz1)End Function将代码复制到模块后单元公式：=zhyz(单元格)指定选择单元区域弹出消息Private Sub Worksheet_SelectionChange(ByVal Target As Range)If Target.Address = $A$1:$

40、C$3 Then MsgBox 你选择对了End IfEnd Sub将B列数据添加超链接到K列Sub 将B列数据添加超链接到K列() For Each Rng In Range(B3:B & B65536.End(xlUp).Row) ActiveSheet.Hyperlinks.Add Anchor:=Rng, Address:=, SubAddress:=Sheet1.Range(K & Rng.Row).Address, ScreenTip:=点击转到: & Sheet1.Name & K & Rng.Row NextEnd Sub删除B列数据的超链接Sub 删除超链接() For Ea

41、ch Rng In Range(B3:B & B65536.End(xlUp).Row) Sheet1.Range(Rng.Address).Hyperlinks.Delete NextEnd Sub分离临时表A列数据的文本和超链接并整理到数据库表Sub 分离A列中的超链接到指定表的B和C列()i = Worksheets(数据库).Range(b60000).End(xlUp).RowFor Each h In Worksheets(临时).HyperlinksWorksheets(数据库).Cells(i + 1, 2) = h.TextToDisplayWorksheets(数据库).C

42、ells(i + 1, 3) = h.AddressRange(Worksheets(数据库).Cells(i + 1, 3), Worksheets(数据库).Cells(i + 1, 3).Hyperlinks.Add Anchor:=Cells(i + 1, 3), Address:=Cells(i + 1, 3)i = i + 1NextEnd Sub分离临时表A列数据的文本和超链接并会同其他数据整理到数据库表Sub 分离A列数据的文本和超链接并会同其他数据整理到指定表()ier = Worksheets(数据库).Range(b60000).End(xlUp).RowFor ee =

43、 5 To Range(a60000).End(xlUp).RowFor Each hh In Worksheets(临时).HyperlinksIf hh.TextToDisplay = Cells(ee, 1) And Cells(ee, 1) Thenwww = www & , & ee End IfNextNextwww = Right(www, Len(www) - 1)zxc = Split(www, ,)For sd = 0 To UBound(zxc) - 1For wee = zxc(sd) + 1 To zxc(sd + 1) - 1Worksheets(数据库).Cell

44、s(sdf + ier + 1, uu + 4) = Cells(wee, 1)uu = uu + 1Nextsdf = sdf + 1uu = 0NextFor Each hhh In Worksheets(临时).Range(A6:A6000).HyperlinksWorksheets(数据库).Cells(ier + 1, 2) = hhh.TextToDisplayWorksheets(数据库).Cells(ier + 1, 3) = hhh.AddressRange(Worksheets(数据库).Cells(ier + 1, 3), Worksheets(数据库).Cells(ie

45、r + 1, 3).Hyperlinks.Add Anchor:=Worksheets(数据库).Cells(ier + 1, 3), Address:=Worksheets(数据库).Cells(ier + 1, 3)ier = ier + 1NextEnd Sub返回A列最后一个非空单元行号Sub 返回A列最后非空单元行号()MsgBox Cells.Range(A65536).End(xlUp).RowEnd Sub返回表中第一个非空单元地址(行搜索)Sub 返回表中第一个非空单元地址()MsgBox Cells.Find(*).AddressEnd Sub返回表中各非空单元区域地址(行

46、搜索)Sub 返回表中各非空单元区域地址()MsgBox Cells.SpecialCells(2).AddressEnd Sub返回第一个数值行号Sub 返回第一个数值行号()MsgBox b:b.SpecialCells(2, 1).RowEnd Sub返回第1行最右边非空单元的列号Sub 返回第1行最右边非空单元的列号()X = IV1.End(xlToLeft).ColumnMsgBox XEnd Sub返回连续数值单元的数量Sub 返回连续数值单元的数量()MsgBox b:b.SpecialCells(2, 1).Rows.CountEnd Sub统计指定范围和内容的单元数量Sub

47、 统计指定范围和内容的单元数量()x = Application.WorksheetFunction.CountIf(Range(A3:B100), 总计)Range(B1) = xEnd Sub统计不同颜色的数字的和（自定义函数）Public Function COLOR(ByVal X As Range, Y)For Each I In X If I.Font.ColorIndex = Y Then COLOR = COLOR + I End IfNext IEnd Function统计红色,输入：=COLOR(B2:B8,3)统计蓝色,输入：=COLOR(B2:B8,5)返回非空单元数量

48、Sub 返回非空单元数量()x = Application.CountA(Range(A1:Z65536)MsgBox xEnd Sub返回A列非空单元数量Sub 返回A列非空单元数量()y = Application.CountA(Columns(1)MsgBox yEnd Sub返回圆周率Sub Macro1()Range(A1) = Application.Pi()End Sub定义指定单元内容为页眉/页脚Sub 定义指定单元内容为页眉/页脚()BBB = Sheets(表1).Range(A2) With ActiveSheet.PageSetup .CenterHeader = BB

49、B 定义页眉 .CenterFooter = BBB 定义页脚 End WithEnd Sub提示并全部清除当前选择区域Sub 提示并全部清除当前选择区域()If MsgBox(你确定要清除选择的区域吗?, vbYesNo, 提示:) = vbYes Then Selection.ClearEnd Sub全部清除当前选择区域Sub 全部清除当前选择区域()Selection.Clear Range(A1:B10).Clear 全部清除指定区域End Sub清除指定区域数值Sub 清除单元数值()Sheet1.A1:A10.ClearContentsEnd SubSub 清除指定区域数值() R

50、ange(A1:C8) = ClearContentsEnd SubSub 清除指定区域数值() Sheet1.A1:A10=End Sub对指定工作表执行取消隐藏打印隐藏工作表Sub 打印隐藏工作表()Sheets(报表1).Visible = 1Sheets(报表1).PrintOut Copies:=1, Collate:=TrueSheets(报表1).Visible = 0End Sub打开文件时执行指定宏(工作簿代码)Private Sub Workbook_Open() 重排窗口 要执行的宏名称End Sub返回A列最后一个非空单元行号Sub 返回A列最后非空单元行号()MsgBox Cells.Range(A65536).End(xlUp).RowEnd Sub返回表中第一个非空单元地址(行搜索)Sub 返回表中第一个非空单元地址()MsgBox Cells.Find(*).AddressEnd Sub返回表中各非空单元区域地址(行搜索)Sub 返回