利用宏命令锁定Excel公式

voko007259个常用宏-excelhome(1)2009-08-15 14:10:24目录1、打开全部隐藏工作表2、循环宏3、录制宏时调用“停止录制”工具栏4、高级筛选5列不重复数据至指定表5、双击单元执行宏(工作表代码)6、双击指定区域单元执行宏(工作表代码)7、进入单元执行宏(工作表代码)8、进入指定区域单元执行宏(工作表代码)9、在多个宏中依次循环执行一个（控件按钮代码）10、在两个宏中依次循环执行一个并相应修改按钮名称（控件按钮代码）11、在三个宏中依次循环执行一个并相应修改按钮名称（控件按钮代码）12、根据A1单元文本隐藏/显示按钮（控件按钮代码）13、当前单元返回按钮名称（控件按钮代码）14、当前单元内容返回到按钮名称（控件按钮代码）15、奇偶页分别打印16、自动打印多工作表第一页17、查找A列文本循环插入分页符18、将A列最后数据行以上的所有B列图片大小调整为所在单元大小19、返回光标所在行数20、在A1返回当前选中单元格数量21、返回当前工作簿中工作表数量22、返回光标选择区域的行数和列数23、工作表中包含数据的最大行数24、返回A列数据的最大行数25、将所选区域文本插入新建文本框26、批量插入地址批注27、批量插入统一批注28、以A1单元内容批量插入批注29、不连续区域插入当前文件名和表名及地址30、不连续区域录入当前单元地址31、连续区域录入当前单元地址32、返回当前单元地址33、不连续区域录入当前日期34、不连续区域录入当前数字日期35、不连续区域录入当前日期和时间36、不连续区域录入对勾37、不连续区域录入当前文件名38、不连续区域添加文本39、不连续区域插入文本40、从指定位置向下同时录入多单元指定内容41、按aa工作表A列的内容排列工作表标签顺序42、以A1单元文本作表名插入工作表43、删除全部未选定工作表44、工作表标签排序45、定义指定工作表标签颜色46、在目录表建立本工作簿中各表链接目录47、建立工作表文本目录48、查另一文件的全部表名49、当前单元录入计算机名50、当前单元录入计算机用户名51、解除全部工作表保护52、为指定工作表加指定密码保护表53、在有密码的工作表执行代码54、执行前需要验证密码的宏(控件按钮代码)55、执行前需要验证密码的宏()56、拷贝A1公式和格式到A257、复制单元数值58、插入数值条件格式59、插入透明批注60、添加文本61、光标定位到指定工作表A列最后数据行下一单元62、定位选定单元格式相同的全部单元格63、按当前单元文本定位64、按固定文本定位65、删除包含固定文本单元的行或列66、定位数据及区域以上的空值67、右侧单元自动加5(工作表代码)68、当前单元加269、A列等于A列减B列70、用于光标选定多区域跳转指定单元(工作表代码)71、将A1单元录入的数据累加到B1单元（工作表代码）72、在指定颜色区域选择单元时添加/取消"√"（工作表代码）73、在指定区域选择单元时添加/取消"√"（工作表代码）74、双击指定单元，循环录入文本（工作表代码）75、双击指定单元，循环录入文本（工作表代码）76、单元区域引用（工作表代码）77、在指定区域选择单元时数值加1（工作表代码）78、混合文本的编号79、指定区域单元双击数据累加（工作表代码）80、选择单元区域触发事件（工作表代码）81、当修改指定单元内容时自动执行宏（工作表代码）82、被指定单元内容限制执行宏83、双击单元隐藏该行（工作表代码）84、高亮显示行（工作表代码）85、高亮显示行和列（工作表代码）86、为指定工作表设置滚动范围（工作簿代码）87、在指定单元记录打印和预览次数（工作簿代码）88、自动数字金额转大写（工作表代码）89、将全部工作表的A1单元作为单击按钮（工作簿代码）90、闹钟——到指定时间执行宏（工作簿代码）91、改变Excel界面标题的宏（工作簿代码）92、在指定工作表的指定单元返回光标当前多选区地址（工作簿代码）93、B列录入数据时在A列返回记录时间（工作表代码）94、当指定区域修改时在其右侧的2个单元返回当前日期和时间（工作表代码）95、指定单元显示光标位置内容（工作表代码）96、每编辑一个单元保存文件97、指定允许编辑区域98、解除允许编辑区域限制99、删除指定行100、删除A列为指定内容的行101、删除A列非数字单元行102、有条件删除当前行103、选择下一行104、选择第5行开始所有数据行105、选择光标或选区所在行106、选择光标或选区所在列107、光标定位到名称指定位置108、选择名称定义的数据区109、选择到指定列的最后行110、将Sheet1的A列的非空值写到Sheet2的A列111、将名称1的数据写到名称2112、单元反选113、调整选中对象中的文字114、去除指定范围内的对象115、更新透视表数据项116、将全部工作表名称写到A列117、为当前选定的多单元插入指定名称118、删除全部名称119、以指定区域为表目录补充新表120、按A列数据批量修改表名称121、按A列数据批量创建新表(控件按钮代码)122、清除剪贴板123、批量清除软回车124、判断指定文件是否已经打开125、当前文件另存到指定目录126、另存指定文件名127、以本工作表名称另存文件到当前目录128、将本工作表单独另存文件到Excel当前默认目录129、以活动工作表名称另存文件到Excel当前默认目录130、另存所有工作表为工作簿131、以指定单元内容为新文件名另存文件133、以当前日期和时间为新文件名另存文件134、另存本表为TXT文件135、引用指定位置单元内容为部分文件名另存文件136、将A列数据排序到D列137、将指定范围的数据排列到D列138、光标所在行上移一行139、加数据有效限制140、取消数据有效限制141、重排窗口143、回车光标向右144、回车光标向下146、保存并退出Excel147、隐藏/显示指定列空值行148、深度隐藏指定工作表149、隐藏指定工作表150、隐藏当前工作表151、返回当前工作表名称152、获取上一次所进入工作簿的工作表名称153、按光标选定颜色隐藏本列其他颜色行154、打开工作簿自动隐藏录入表以外的其他表155、除最左边工作表外深度隐藏所有表156、关闭文件时自动隐藏指定工作表(ThisWorkbook) 157、打开文件时提示指定工作表是保护状态(ThisWorkbook) 158、插入10行159、全选固定范围内小于0的单元160、全选选定范围内小于0的单元161、固定区域单元分类变色162、A列半角内容变红163、单元格录入数据时运行宏的代码164、根据B列最后数据快速合并A列单元格的控件代码165、在F1单元显示光标位置批注内容的代码166、显示光标所在单元的批注的代码167、使单元内容保持不变的工作表代码168、有条件执行宏169、有条件执行不同的宏170、提示确定或取消执行宏171、提示开始和结束172、拷贝指定表不相邻多列数据到新位置173、选择2至4行174、在当前选区有条件替换数值为文本175、自动筛选全部显示指定列176、自动筛选第2列值为A的行177、取消自动筛选()178、全部显示指定表的自动筛选179、强行合并单元180、设置单元区域格式181、在所有工作表的A1单元返回顺序号182、根据A1单元内容返回C1数值183、根据A1内容选择执行宏184、删除A列空行185、在A列产生不重复随机数186、将A列数据随机排列到F列187、取消选定区域的公式只保留值(假空转真空)188、处理导入的显示为科学计数法样式的身份证号189、返回指定单元的行高和列宽190、指定行高和列宽191、指定单元的行高和列宽与A1单元相同191、填公式192、建立当前工作表的副本为001表193、在第一个表前插入多工作表194、清除A列再插入序号195、反方向文本(自定义函数)196、指定选择单元区域弹出消息197、将B列数据添加超链接到K列198、删除B列数据的超链接199、分离临时表A列数据的文本和超链接并整理到数据库表200、分离临时表A列数据的文本和超链接并会同其他数据整理到数据库表201、返回A列最后一个非空单元行号202、返回表中第一个非空单元地址(行搜索)203、返回表中各非空单元区域地址(行搜索)204、返回第一个数值行号205、返回第1行最右边非空单元的列号206、返回连续数值单元的数量207、统计指定范围和内容的单元数量208、统计不同颜色的数字的和（自定义函数）209、返回非空单元数量210、返回A列非空单元数量211、返回圆周率π212、定义指定单元内容为页眉/页脚213、提示并全部清除当前选择区域214、全部清除当前选择区域215、清除指定区域数值216、对指定工作表执行取消隐藏》打印》隐藏工作表217、打开文件时执行指定宏(工作簿代码)218、关闭文件时执行指定宏(工作簿代码)219、弹出提示A1单元内容220、延时15秒执行重排窗口宏221、撤消工作表保护并取消密码222、重算指定表223、将第5行移到窗口的最上面224、对第一张工作表的指定区域进行排序225、显示指定工作表的打印预览226、用单元格A1的内容作为文件名另存当前工作簿227、[禁用/启用]保存和另存的代码228、在A和B列返回当前选区的名称和公式229、朗读朗读A列,按ESC键中止230、朗读固定语句，请按ESC键终止231、在M和N列的14行以下选择单元时显示调用日历控件（工作表代码）232、添加自定义序列233、弹出打印对话框234、返回总页码235、合并各工作表内容236、合并指定目录中所有文件中相同格式工作表的数据237、隐藏指定工作表的指定列238、把a列不重复值取到e列239、当前选区的行列数240、单元格录入1位字符就跳转(工作表代码)241、当指定日期（每月10日）打开文件执行宏242、提示并清空单元区域243、返回光标所在行号244、按照当前行A列的图片名称插入图片到H列245、当前行下插入1行246、取消指定行或列的隐藏247、复制单元格所在行248、复制单元格所在列249、新建一个工作表250、新建一个工作簿251、选择多表为工作组252、在当前工作组各表中分别执行指定宏253、复制当前工作簿的报表到临时工作簿254、删除指定文件255、合并A1至C1的内容写到D15单元的批注中256、自动重算257、手动重算1、打开全部隐藏工作表Sub 打开全部隐藏工作表()Dim i As IntegerFor i = 1 To Sheets.CountSheets(i).V isible = TrueNext iEnd Sub2、循环宏Sub 循环()AAA = Range("C2")Dim i As LongDim times As Longtimes = AAA'times代表循环次数，执行前把times赋值即可(不可小于1，不可大于2147483647) For i = 1 To timesCall 过滤一行If Range("完成标志") = "完成" ThenExit For'如果名为'完成标志'的命名单元的值等于'完成',则退出循环,如果一开始就等于'完成',则只执行一次循环就退出'If Sheets("传送参数").Range("A" & i).Text = "完成" Then Exit For'如果某列出现"完成"内容则退出循环Next iEnd Sub3、录制宏时调用“停止录制”工具栏Sub 录制宏时调用停止录制工具栏()mandBars("Stop Recording").V isible = TrueEnd Sub4、高级筛选5列不重复数据至指定表Sub 高级筛选5列不重复数据至Sheet2()Sheets("Sheet2").Range("A1:E65536") = "" '清除Sheet2的A:D列Range("A1:E65536").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheet2.Range( _"A1"), Unique:=TrueSheet2.Columns("A:E").Sort Key1:=Sheet2.Range("A2"), Order1:=xlAscending, Header:=xlGuess, _OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _:=xlPinYinEnd Sub5、双击单元执行宏(工作表代码)Private Sub Worksheet_BeforeDoubleClick(ByV al Target As Range, Cancel As Boolean) If Range("$A$1") = "关闭" ThenExit SubSelect Case Target.AddressCase "$A$4"Call 宏1Cancel = TrueCase "$B$4"Call 宏2Cancel = TrueCase "$C$4"Call 宏3Cancel = TrueCase "$E$4"Call 宏4Cancel = TrueEnd SelectEnd Sub6、双击指定区域单元执行宏(工作表代码)Private Sub Worksheet_BeforeDoubleClick(ByV al Target As Range, Cancel As Boolean) If Range("$A$1") = "关闭" Then Exit SubIf Not Application.Intersect(Target, Range("A4:A9", "C4:C9")) Is Nothing Then Call 打开隐藏表End Sub7、进入单元执行宏(工作表代码)Private Sub Worksheet_SelectionChange(ByV al Target As Range)'以单元格进入代替按钮对象调用宏If Range("$A$1") = "关闭" Then Exit SubSelect Case Target.AddressCase "$A$5" '单元地址(Target.Address),或命名单元名字()Call 宏1Case "$B$5"Call 宏2Case "$C$5"Call 宏3End SelectEnd Sub8、进入指定区域单元执行宏(工作表代码)Private Sub Worksheet_SelectionChange(ByV al Target As Range)If Range("$A$1") = "关闭" Then Exit SubIf Not Application.Intersect(Target, Range("A4:A9","C4:C9")) Is Nothing Then Call 打开隐藏表End Sub9、在多个宏中依次循环执行一个（控件按钮代码）Private Sub CommandButton1_Click()Static RunMacro As IntegerSelect Case RunMacroCase 0宏1RunMacro = 1Case 1宏2RunMacro = 2Case 2宏3RunMacro = 0End SelectEnd Sub10、在两个宏中依次循环执行一个并相应修改按钮名称（控件按钮代码）Private Sub CommandButton1_Click()With CommandButton1If .Caption = "保护工作表" ThenCall 保护工作表.Caption = "取消工作表保护"Exit SubEnd IfIf .Caption = "取消工作表保护" ThenCall 取消工作表保护.Caption = "保护工作表"Exit SubEnd IfEnd WithEnd Sub11、在三个宏中依次循环执行一个并相应修改按钮名称（控件按钮代码）Option ExplicitPrivate Sub CommandButton1_Click()With CommandButton1If .Caption = "宏1" ThenCall 宏1.Caption = "宏2"Exit SubEnd IfIf .Caption = "宏2" ThenCall 宏2.Caption = "宏3"Exit SubEnd IfIf .Caption = "宏3" ThenCall 宏3.Caption = "宏1"Exit SubEnd IfEnd WithEnd Sub12、根据A1单元文本隐藏/显示按钮（控件按钮代码）Private Sub Worksheet_SelectionChange(ByV al Target As Range) If Range("A1") > 2 ThenCommandButton1.Visible = 1ElseCommandButton1.Visible = 0End IfEnd SubPrivate Sub CommandButton1_Click()重排窗口End Sub13、当前单元返回按钮名称（控件按钮代码）Private Sub CommandButton1_Click()ActiveCell = CommandButton1.CaptionEnd Sub14、当前单元内容返回到按钮名称（控件按钮代码）Private Sub CommandButton1_Click()CommandButton1.Caption = ActiveCellEnd Sub15、奇偶页分别打印Sub 奇偶页分别打印()Dim i%, Ps%Ps = ExecuteExcel4Macro("GET.DOCUMENT(50)") '总页数MsgBox "现在打印奇数页,按确定开始."For i = 1 To Ps Step 2ActiveSheet.PrintOut from:=i, To:=iNext iMsgBox "现在打印偶数页,按确定开始."For i = 2 To Ps Step 2ActiveSheet.PrintOut from:=i, To:=iNext iEnd Sub16、自动打印多工作表第一页Sub 自动打印多工作表第一页()Dim sh As IntegerDim xDim yDim syDim syzx = InputBox("请输入起始工作表名字:")sy = InputBox("请输入结束工作表名字:")y = Sheets(x).Indexsyz = Sheets(sy).IndexFor sh = y To syzSheets(sh).SelectSheets(sh).PrintOut from:=1, To:=1Next shEnd Sub17、查找A列文本循环插入分页符Sub 循环插入分页符()' Selection = Workbooks("临时表").Sheets("表2").Range("A1") 调用指定地址内容Dim i As LongDim times As Longtimes = Application.WorksheetFunction.CountIf(Sheet1.Range("a:a"), "分页") 'times代表循环次数，执行前把times赋值即可(不可小于1，不可大于2147483647) For i = 1 To timesCall 插入分页符Next iEnd SubSub 插入分页符()Cells.Find(What:="分页", After:=ActiveCell, LookIn:=xlV alues, LookAt:= _xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _.ActivateActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCellEnd SubSub 取消原分页()Cells.SelectActiveSheet.ResetAllPageBreaksEnd Sub18、将A列最后数据行以上的所有B列图片大小调整为所在单元大小Sub 将A列最后数据行以上的所有B列图片大小调整为所在单元大小() Dim Pic As Picture, i&i = [A65536].End(xlUp).RowFor Each Pic In Sheet1.PicturesIf Not Application.Intersect(Pic.TopLeftCell, Range("B1:B" & i)) Is Nothing Then Pic.Top = Pic.TopLeftCell.TopPic.Left = Pic.TopLeftCell.LeftPic.Height = Pic.TopLeftCell.HeightPic.Width = Pic.TopLeftCell.WidthEnd IfNextEnd Sub19、返回光标所在行数Sub 返回光标所在行数()x = ActiveCell.RowRange("A1") = xEnd Sub20、在A1返回当前选中单元格数量Sub 在A1返回当前选中单元格数量()[A1] = Selection.CountEnd Sub21、返回当前工作簿中工作表数量Sub 返回当前工作簿中工作表数量()t = Application.Sheets.CountMsgBox tEnd Sub22、返回光标选择区域的行数和列数Sub 返回光标选择区域的行数和列数()x = Selection.Rows.County = Selection.Columns.CountRange("A1") = xRange("A2") = yEnd Sub23、工作表中包含数据的最大行数Sub 包含数据的最大行数()n = Cells.Find("*", , , , 1, 2).RowMsgBox nEnd Sub24、返回A列数据的最大行数Sub 返回A列数据的最大行数()n = Range("a65536").End(xlUp).RowRange("B1") = nEnd Sub25、将所选区域文本插入新建文本框Sub 将所选区域文本插入新建文本框()For Each rag In Selectionn = n & rag.V alue & Chr(10)NextActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, ActiveCell.Left + ActiveCell.Width, ActiveCell.Top + ActiveCell.Height, 250#, 100).SelectSelection.Characters.Text = "问题：" & nWith Selection.Characters(Start:=1, Length:=3).Font.Name = "黑体".FontStyle = "常规".Size = 12End WithEnd Sub26、批量插入地址批注Sub 批量插入地址批注()On Error Resume NextDim r As RangeIf Selection.Cells.Count > 0 ThenFor Each r In Selectionment.Deleter.AddCommentment.V isible = Falsement.Text Text:="本单元格：" & r.Address & " of " & Selection.Address NextEnd IfEnd Sub27、批量插入统一批注Sub 批量插入统一批注()Dim r As Range, msg As Stringmsg = InputBox("请输入欲批量插入的批注", "提示", "随便输点什么吧")If Selection.Cells.Count > 0 ThenFor Each r In Selectionr.AddCommentment.V isible = Falsement.Text Text:=msgNextEnd IfEnd Sub28、以A1单元内容批量插入批注Sub 以A1单元内容批量插入批注()Dim r As RangeIf Selection.Cells.Count > 0 ThenFor Each r In Selectionr.AddCommentment.V isible = Falsement.Text Text:=[a1].TextNextEnd IfEnd Sub29、不连续区域插入当前文件名和表名及地址Sub 批量插入当前文件名和表名及地址()For Each mycell In Selectionmycell.FormulaR1C1 = "[" + + "]" + + "!" + mycell.AddressNextEnd Sub30、不连续区域录入当前单元地址Sub 区域录入当前单元地址()For Each mycell In Selectionmycell.FormulaR1C1 = mycell.AddressNextEnd Sub31、连续区域录入当前单元地址Sub 连续区域录入当前单元地址()Selection = "=ADDRESS(ROW(),COLUMN(),4,1)"Selection.CopySelection.PasteSpecial Paste:=xlPasteV alues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=FalseEnd Sub32、返回当前单元地址Sub 返回当前单元地址()d = ActiveCell.Address[A1] = dEnd Sub33、不连续区域录入当前日期Sub 区域录入当前日期()Selection.FormulaR1C1 = Format(Now(), "yyyy-m-d")End Sub34、不连续区域录入当前数字日期Sub 区域录入当前数字日期()Selection.FormulaR1C1 = Format(Now(), "yyyymmdd")End Sub35、不连续区域录入当前日期和时间Sub 区域录入当前日期和时间()Selection.FormulaR1C1 = Format(Now(), "yyyy-m-d h:mm:ss") End Sub36、不连续区域录入对勾Sub 批量录入对勾()Selection.FormulaR1C1 = "√"End Sub37、不连续区域录入当前文件名Sub 批量录入当前文件名()Selection.FormulaR1C1 = End Sub38、不连续区域添加文本Sub 批量添加文本()Dim s As RangeFor Each s In Selections = s & "文本内容"NextEnd Sub39、不连续区域插入文本Sub 批量插入文本()Dim s As RangeFor Each s In Selections = "文本内容" & sNextEnd Sub40、从指定位置向下同时录入多单元指定内容Sub 从指定位置向下同时录入多单元指定内容()Dim arrarr = Array("1", "2", "13", "25", "46", "12", "0", "20")[B2].Resize(8, 1) = Application.WorksheetFunction.Transpose(arr) End Sub41、按aa工作表A列的内容排列工作表标签顺序Sub 按aa工作表A列的内容排列工作表标签顺序() Dim I%, str1$I = 1Sheets("aa").SelectDo While Cells(I, 1).V alue <> ""str1 = Trim(Cells(I, 1).V alue)Sheets(str1).SelectSheets(str1).Move after:=Sheets(I)I = I + 1Sheets("aa").SelectLoopEnd Sub42、以A1单元文本作表名插入工作表Sub 以A1单元文本作表名插入工作表()Dim nm As Stringnm = [a1]Sheets.Add = nmEnd Sub43、删除全部未选定工作表Sub 删除全部未选定工作表()Dim sht As Worksheet, n As Integer, iFlag As BooleanDim ShtName() As Stringn = ActiveWindow.SelectedSheets.CountReDim ShtName(1 To n)n = 1For Each sht In ActiveWindow.SelectedSheetsShtName(n) = n = n + 1NextApplication.DisplayAlerts = FalseFor Each sht In SheetsiFlag = FalseFor i = 1 To n - 1If ShtName(i) = TheniFlag = TrueExit ForEnd IfNextIf Not iFlag Then sht.DeleteNextApplication.DisplayAlerts = TrueEnd Sub44、工作表标签排序Sub 工作表标签排序()Dim i As Long, j As Long, nums As Long, msg As Longmsg = MsgBox("工作表按升序排列请选'是[Y]'. " & vbCrLf & vbCrLf & "工作表按降序排列请选'否[N]'", vbY esNoCancel, "工作表排序")If msg = vbCancel Then Exit Subnums = Sheets.CountIf msg = vbY es Then 'Sort ascendingFor i = 1 To numsFor j = i To numsIf UCase(Sheets(j).Name) < UCase(Sheets(i).Name) ThenSheets(j).Move Before:=Sheets(i)End IfNext jNext iElse 'Sort descendingFor i = 1 To numsFor j = i To numsIf UCase(Sheets(j).Name) > UCase(Sheets(i).Name) ThenSheets(j).Move Before:=Sheets(i)End IfNext jNext iEnd IfEnd Sub259个常用宏-excelhome(2)2009-08-15 14:11:4545、定义指定工作表标签颜色Sub 定义指定工作表标签颜色()Sheets("Sheet1").Tab.ColorIndex = 46End Sub46、在目录表建立本工作簿中各表链接目录Sub 在目录表建立本工作簿中各表链接目录()Dim s%, Rng As RangeOn Error Resume NextSheets("目录").ActivateIf Err = 0 ThenSheets("目录").UsedRange.DeleteElseSheets.Add = "目录"End IfFor i = 1 To Sheets.CountIf Sheets(i).Name <> "目录" Thens = s + 1Set Rng = Sheets("目录").Cells(((s - 1) Mod 20) + 1, (s - 1) \ 20 + 1 + 1)Rng = Format(s, " 0") & ". " & Sheets(i).NameActiveSheet.Hyperlinks.Add Rng, "#" & Sheets(i).Name & "!A1", ScreenTip:=Sheets(i).NameEnd IfNextSheets("目录").Range("b:iv").EntireColumn.ColumnWidth = 20End Sub47、建立工作表文本目录Sub 建立工作表文本目录()Sheets.Add before:=Sheets(1)Sheets(1).Name = "目录"For i = 2 To Sheets.CountCells(i - 1, 1) = Sheets(i).Name'Sheets(1).Hyperlinks.Add Cells(i - 1, 1), "#" & Sheets(i).Name & "!A1" '添加超链接NextEnd Sub48、查另一文件的全部表名Sub 查另一文件的全部表名()On Error Resume NextDim i%Dim sh As WorksheetApplication.ScreenUpdating = FalseWorkbooks.Open Filename:=ThisWorkbook.Path & "\2.xls"Windows("1.xls").Activate '当前文件名称Sheets("Sheet1").Select '当前表名称i = 1 '将表名称返回到第1行For Each sh In Workbooks("2.xls").WorksheetsCells(i, 1) = '将表名称返回到第1列i = i + 1 '返回每个表名称向下移动1行Next shWindows("2.xls").Close '关闭对象文件Application.ScreenUpdating = TrueEnd Sub49、当前单元录入计算机名Sub 当前单元录入计算机名()Selection = Environ("COMPUTERNAME")'Selection = Workbooks("临时表").Sheets("表2").Range("A1") 调用指定地址内容End Sub50、当前单元录入计算机用户名Sub 当前单元录入计算机用户名()Selection = Environ("Username")'Selection = Workbooks("临时表").Sheets("表2").Range("A1") 调用指定地址内容End Sub51、解除全部工作表保护Sub 解除全部工作表保护()Dim n As IntegerFor n = 1 To Sheets.CountSheets(n).UnprotectNext nEnd Sub52、为指定工作表加指定密码保护表Sub 为指定工作表加指定密码保护表()Sheet10.Protect Password:="123"End Sub53、在有密码的工作表执行代码Sub 在有密码的工作表执行代码()Sheets("1").Unprotect Password:=123 '假定表名为“1”，密码为“123”打开工作表Range("C:C").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True '隐藏C列空值行Sheets("1").Protect Password:=123 '重新用密码保护工作表End Sub54、执行前需要验证密码的宏(控件按钮代码)Private Sub CommandButton1_Click()If InputBox("请输入密码：") <> "123" Then '密码是123MsgBox "密码错误,按确定退出!", 64, "提示"Exit SubEnd IfCells(1, 1) = 10End Sub55、执行前需要验证密码的宏()Sub 执行前需要验证密码的宏()If InputBox("请输入您的使用权限:", "系统提示") = 123 Then重排窗口'要执行的宏代码或宏名称ElseMsgBox "对不起,您没有使用该宏的权限,按确定键后退出!"End IfEnd Sub56、拷贝A1公式和格式到A2Sub 拷贝A1公式到A2()Workbooks("临时表").Sheets("表1").Range("A1").CopyWorkbooks("临时表").Sheets("表2").Range("A2").PasteSpecialEnd Sub57、复制单元数值Sub 复制数值()s = Workbooks("book1").Sheets("Sheet1").Range("A1:A2")Workbooks("book2").Sheets("Sheet1").Range("A1:A2") = sEnd Sub58、插入数值条件格式Sub 插入数值条件格式()Selection.FormatConditions.DeleteSelection.FormatConditions.Add Type:=xlCellV alue, Operator:=xlGreater, _ Formula1:="70"Selection.FormatConditions(1).Interior.ColorIndex = 45Selection.FormatConditions.Add Type:=xlCellV alue, Operator:=xlLess, _ Formula1:="55"Selection.FormatConditions(2).Interior.ColorIndex = 39Selection.FormatConditions.Add Type:=xlCellV alue, Operator:=xlGreater, _ Formula1:="60"Selection.FormatConditions(3).Interior.ColorIndex = 34End Sub59、插入透明批注Sub 插入透明批注()Selection.AddCommentment.Visible = FalseDim XS As WorksheetFor i = 1 To ments.Countments(i).Text "透明批注"ments(i).Shape.Fill.Visible = msoFalseNextEnd Sub60、添加文本Sub 添加文本()Selection = Selection + "×" '不可在数字后添加文本'Selection = Workbooks("临时表").Sheets("表2").Range("A1") 调用指定地址内容End Sub61、光标定位到指定工作表A列最后数据行下一单元Sub 光标定位到指定工作表A列最后数据行下一单元()a = Sheets("数据库").[a65536].End(xlUp).RowSheets("数据库").SelectRange("A" & a + 1).SelectEnd Sub62、定位选定单元格式相同的全部单元格Sub 定位选定单元格式相同的全部单元格()Dim FirstCell As Range, FoundCell As RangeDim AllCells As RangeWith Application.FindFormat.Clear.NumberFormatLocal = Selection.NumberFormatLocal.HorizontalAlignment = Selection.HorizontalAlignment.V erticalAlignment = Selection.V erticalAlignment.WrapText = Selection.WrapText.Orientation = Selection.Orientation.AddIndent = Selection.AddIndent.IndentLevel = Selection.IndentLevel.ShrinkToFit = Selection.ShrinkToFit.MergeCells = Selection.MergeCells = .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.FormulaHiddenEnd WithSet FirstCell = edRange.Find(what:="", searchformat:=True)If FirstCell Is Nothing ThenExit SubEnd IfSet AllCells = FirstCellSet FoundCell = FirstCellDoSet FoundCell = edRange.Find(After:=FoundCell, what:="", searchformat:=True)If FoundCell Is Nothing Then Exit DoSet AllCells = Union(FoundCell, AllCells)If FoundCell.Address = FirstCell.Address Then Exit DoLoopAllCells.SelectEnd Sub63、按当前单元文本定位Sub 按当前单元文本定位()ABC = SelectionDim aa As RangeFor Each a In edRangeIf a Like ABC ThenIf aa Is Nothing ThenSet aa = a.CellsElseSet aa = Union(aa, a.Cells)End IfEnd IfNextaa.SelectEnd Sub64、按固定文本定位Sub 文本定位()Dim aa As RangeFor Each a In edRangeIf a Like "*合计*" ThenIf aa Is Nothing ThenSet aa = a.CellsElseSet aa = Union(aa, a.Cells)End IfEnd IfNextaa.SelectEnd Sub65、删除包含固定文本单元的行或列Sub 删除包含固定文本单元的行或列()DoCells.Find(what:="哈哈").ActivateSelection.EntireRow.Delete '删除行' Selection.EntireColumn.Delete '删除列Loop Until Cells.Find(what:="哈哈") Is Nothing End Sub66、定位数据及区域以上的空值Sub 定位数据及区域以上的空值()Dim aa As RangeFor Each a In edRangeIf a Like 〈0 ThenIf aa Is Nothing ThenSet aa = a.CellsElseSet aa = Union(aa, a.Cells)End IfEnd IfNextaa.SelectEnd Sub67、右侧单元自动加5(工作表代码)Private Sub Worksheet_Change(ByV al Target As Range)Application.EnableEvents = FalseTarget.Offset(0, 1) = Target + 5Application.EnableEvents = TrueEnd Sub68、当前单元加2Sub 当前单元加2()Selection = Selection + 2'Selection = Workbooks("临时表").Sheets("表2").Range("A1") 调用指定地址内容End Sub69、A列等于A列减B列Sub A列等于A列减B列()For i = 1 To 23Cells(i, 1) = Cells(i, 1) - Cells(i, 2)NextEnd Sub70、用于光标选定多区域跳转指定单元(工作表代码)Private Sub Worksheet_SelectionChange(ByV al T As Range)a = Array([b6:b7], [e6], [h6])For i = 0 To 2If Not Application.Intersect(T, a(i)) Is Nothing Then[a1].Select: Exit ForEnd IfNextEnd Sub71、将A1单元录入的数据累加到B1单元（工作表代码）Private Sub Worksheet_Change(ByV al Target As Range)Dim t As LongIf Target.Address = "$A$1" Thent = Sheet1.Range("$B$1").V alueSheet1.Range("$B$1").V alue = t + Target.V alueEnd IfEnd Sub72、在指定颜色区域选择单元时添加/取消"√"（工作表代码）Private Sub Worksheet_SelectionChange(ByV al Target As Range)Dim myrg As RangeFor Each myrg In TargetIf myrg.Interior.ColorIndex = 37 Then myrg = IIf(myrg <> "√", "√", "") NextEnd Sub73、在指定区域选择单元时添加/取消"√"（工作表代码）Private Sub Worksheet_SelectionChange(ByV al Target As Range)Dim Rng As RangeIf Target.Count <= 15 ThenIf Not Application.Intersect(Target, Range("D6:D20")) Is Nothing Then For Each Rng In SelectionWith RngIf .V alue = "" Then.V alue = "√"Else.V alue = ""End IfEnd WithNextEnd IfEnd IfEnd Sub74、双击指定单元，循环录入文本（工作表代码）Private Sub Worksheet_BeforeDoubleClick(ByV al T As Range, Cancel As Boolean) If T.Address <> "$A$1" Then Exit SubCancel = TrueT = IIf(T = "好", "中", IIf(T = "中", "差", "好"))End Sub75、双击指定单元，循环录入文本（工作表代码）Dim nums As BytePrivate Sub Worksheet_BeforeDoubleClick(ByV al Target As Range, Cancel As Boolean)If Target.Address = "$A$1" Thennums = nums Mod 3 + 1Target = Mid("上中下", nums, 1)Target.Offset(1, 0).SelectEnd IfEnd Sub76、单元区域引用（工作表代码）Private Sub Worksheet_Activate()Sheet1.Range("A1:B3").V alue = Sheet2.Range("A1:B3").V alueEnd Sub77、在指定区域选择单元时数值加1（工作表代码）Private Sub Worksheet_SelectionChange(ByV al Target As Range)If Not Application.Intersect([a1:e10], Target) Is Nothing ThenTarget = V al(Target) + 1End IfEnd Sub259个常用宏-excelhome(3)2009-08-15 14:12:5878、混合文本的编号Sub 混合文本的编号()Worksheets(1).Range("B2").V alue = "北京" & (--(Mid(Worksheets(1).Range("B2"), 3, 100)) + 1) End Sub79、指定区域单元双击数据累加（工作表代码）。

[计算机]利用Excel中宏的功能可以一次性准确地锁定全部公式利用Excel中宏的功能可以一次性准确地锁定全部公式，方法如下: 一、简单制作好一个带有公式的表格，然后用鼠标点击“工具”菜单，在下拉菜单中指向“保护”，单击级连菜单“保护工作表”命令，在出现的对话框中输入密码确定后返回。

二、鼠标点击“工具”菜单，在下拉菜单中指向“宏”，单击级连菜单“录制新宏”，出现录制新宏对话框，在“宏名”下输入“锁定公式”，并将其保存在“新工作簿”，确定后返回。

三、开始宏的操作录制，步骤如下:1、鼠标点击“工具”菜单，在下拉菜单中指向“保护”，单击级连菜单“撤消工作表保护”命令。

2、将光标定位在行号列标的左上角空白处点击，选中整个工作表，然后右击鼠标，在出现的快捷菜单中左击“设置单元格格式”，出现“单元格格式”选项卡，选择“保护”标签卡，清除其中“锁定”前的“?”，确定后返回。

3 、鼠标点击“编辑”菜单，在下拉菜单中左击“定位”命令，在其出现的“定位”对话框中点击“定位条件”按钮，出现“定位条件”对话框，在“选择”下的单选项中选中“公式”，确定后返回，这样凡有公式的地方均被选中。

此时鼠标右击选中区域，设置单元格格式”，出现“单元格格式”选项卡，在出现的快捷菜单中左击“选择“保护”标签卡，选中其中“锁定”前的“?”，确定后返回。

4、鼠标点击“工具”菜单，在下拉菜单中指向“保护”，单击级连菜单“保护命令，在出现的对话框中输入密码，确定后返回。

工作表”5 、鼠标点击“工具”菜单，在下拉菜单中指向“ 宏”，单击级连菜单“ 停止录制”。

6、鼠标点击“工具”菜单，在下拉菜单中指向“宏”，单击级连菜单“宏”，出现“宏”对话框，在其中点击“编辑”按钮，出现 Excel 自带的VB、编程窗口，直接将刚才录制的宏按一定的路径、名称保存(如: C:\锁定公式) 后退出，至此锁定公式的宏录制已完成。

四、定制锁定公式工具按钮，方法如下:1、鼠标右击常用工具栏的空白处，在出现的快捷菜单中点击“自定义”命令，出现“自定义”选项卡，选择其中“命令”标签，在“类别”下选取“宏”，将其右侧对应的“自定义按钮”拖放到常用工具栏中。

各种ExcelVBA的命令2-电脑资料本示例重复最近用户界面命令，。

本示例必须放在宏的第一行。

Application.Repeat下例中，变量counter 代替了行号。

此过程将在单元格区域C1:C20 中循环，将所有绝对值小于 0.01 的数字都设置为 0（零）。

Sub RoundToZero1()For Counter = 1 To 20Set curCell = Worksheets("Sheet1").Cells(Counter, 3)If Abs(curCell.Value) 0 Then' Application.ActivePRinter = "\\zdserver2\HP LaserJet 5000 PCL 6在 Ne00:" '指定打印机ActiveWindow.SelectedSheets.PrintOutCopies:=myPrintNum,Collate:=True '设置打印信息,其中Copies:=myPrint为打印份数ElseMsgBox "请输入要打印的份数"End IfActiveSheet.ShowAllData '全部显示ActiveSheet.Protect Password:=641112 ' 保护工作表并设置密码Sheets("封面").SelectApplication.ScreenUpdating = TrueEnd SubSub 打印余额()Application.ScreenUpdating = FalseSheets("余额表").SelectCall 重算所有表ActiveSheet.Unprotect Password:=641112 '撤消工作表保护并取消密码ActiveWindow.ScrollColumn = 10Selection.AutoFilter Field:=1, Criteria1:=""'以下10行弹出窗口输入打印信息Dim myPrintNum As IntegerDim myPrompt, myTitle As StringmyPrompt = "请输入要打印的份数"myTitle = "打印选取范围"myPrintNum = Application.InputBox(myPrompt, myTitle, 4, , , , , 1)If myPrintNum 0 Then' Application.ActivePrinter = "\\zdserver2\HP LaserJet 5000 PCL 6 在Ne00:" ' '指定打印机ActiveWindow.SelectedSheets.PrintOutCopies:=myPrintNum,Collate:=True '设置打印信息,其中Copies:=myPrint为打印份数ElseMsgBox "请输入要打印的份数"End IfActiveSheet.ShowAllData '全部显示ActiveSheet.Protect Password:=641112 ' 保护工作表并设置密码Sheets("封面").SelectApplication.ScreenUpdating = TrueEnd SubSub 备份()Dim y '变量声明-需保存工作表的路径和名称[M1] = ActiveWorkbook.FullName '单元格M1=当前工作簿的路径和名称y = cells(1, 14) 'Y=单元格N1的值,即计算后的需保存工作簿的路径和名称Worksheets("封面").UsedRange.Columns("M:N").Calculate '计算指定区域ActiveWorkbook.SaveCopyAs y '备份到指定路么YEnd SubSub 重算活动表()With Application.Calculation = xlManual.MaxChange = 0.001End WithActiveWorkbook.PrecisionAsDisplayed = TrueActiveWindow.DisplayZeros = TrueActiveSheet.CalculateEnd SubSub 重算指定表()Attribute 重算指定表.VB_ProcData.VB_Invoke_Func = "z\n14"Worksheets("银行帐").CalculateWorksheets("日报表").CalculateEnd Sub单元格数据改变引起计算激活过程Private Sub Worksheet_Change(ByVal Target As Range)Dim irow, icol As Integerirow = Target.Row '变量行irowicol = Target.Column '变量列icolIf irow > 6 And icol = 3 And cells(irow, 3) >= cells(irow - 1, 3)Then '>大于6行,并且第3列,当本行 3列>2行3列Application.EnableEvents = Falsecells(irow, 2) = cells(irow - 1, 2) '本行 2 列=上一行2列Application.EnableEvents = TrueElseIf irow > 6 And icol = 3 And cells(irow, 3) 大于6行,并且第3列,当本行 3列>2行3列Application.EnableEvents = Falsecells(irow, 2) = cells(irow - 1, 2) + 1 '本行 2 列=上行2列+1Application.EnableEvents = TrueElseIf (icol = 3 Or icol = 4 Or icol = 6 Or icol = 8 Or icol = 9 Oricol = 10 Or icol = 12 Or icol = 13) And irow > 6 Then 'And Target""Application.EnableEvents = Falsecells(irow, 5) = "=单位名称"cells(irow, 7) = "=摘要"cells(irow, 11) = "=余额"Range(cells(irow, 14), cells(irow, 16)) = "=预内外收支NOP"cells(irow, 17) = "=审核Q"cells(irow, 18) = "=对帐U"Range(cells(irow, 19), cells(irow, 20)) = "=内转收支XY"cells(irow, 21) = "=政采Z"Application.EnableEvents = TrueEnd IfEnd Sub'计算当前工作表路径及名称的函数,可作为单元格公式,也可写入宏=CELL("FILENAME")'改变Excel界面标题的宏Private Sub Workbook_Open()Application.Caption = "吃过了"End Sub'自动刷新单元格A1内显示的日期\时间的宏Sub mytime()Range("a1") = Now()Application.OnTime Now + TimeValue("00:00:01"), "mytime"End Sub'用单元格A1的内容作为文件名保存当前工作簿的宏Sub b()ActiveWorkbook.SaveCopyAs Range("A1") + ".xls"End Sub'激活窗体的宏,此宏写入有窗体的工作表内Private Sub CommandButton1_Click() '点数据录入按钮控件激活窗体Load UserForm3 '激活窗体UserForm3.StartUpPosition = 3 '激活窗体UserForm3.Show '激活窗体End Sub'以下为窗体中点击各按钮运行的宏,写入窗体内Public pos As Integer '声明变量pos'战友确定按钮语句Private Sub CommandButton1_Click()Application.ScreenUpdating = False '此句和最后一句旨在不显示宏的执行过程'On Error GoTo ErrorHandle '可以不要'ErrorHandle: '可以不要'If Err.Number = 13 Then '可以不要'Exit Sub '可以不要'End If '可以不要Call writeToWorkSheet '执行宏writetoworksheetUserForm3.Hide '退出窗体,继续按钮少此句,退出按钮执行此句Unload UserForm3 '退出窗体,继续按钮少此句,退出按钮执行此句Call 批量打印 '[此处到接顺序2][L2] = "" '[到此处结束]Sheets("打印信息").SelectApplication.ScreenUpdating = TrueEnd Sub'退出按钮语句Private Sub CommandButton2_Click()UserForm3.HideUnload UserForm3End Sub'将窗体内的文本框中的数据写进工作表的单元格Private Sub writeT oWorkSheet()ActiveSheet.Range("k2") = TextBox1.Value '将文字框内容写进k列ActiveSheet.Range("l2") = TextBox2.Value '将文字框内容写进l 列TextBox1.Value = "" '清空文字框内容TextBox2.Value = "" '清空文字框内容Worksheets("打印信息").Range("a2").Value = 1 '给指定表的单元格写入数据Worksheets("打印信息").Range("B3:E113").Value = "" '清空指定表的单元格数据End Sub'以下为根据条件打印的宏Sub 打印() '部门明细查询及批星打印Application.ScreenUpdating = False '关闭屏幕更新If Cells(1, 4) = "" And Cells(1, 5) = "" Then '打印条件Cells(3,13) = 1 And' Application.ActivePrinter = "\\zdserver2\HP LaserJet 5000 PCL6 在 Ne00:" ' '指定打印机ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True'设置默认打印机的打印信息,其中Copies:=myPrint为打印份数ElseCall 打印信息 '打倒为假时执行End IfApplication.ScreenUpdating = True '关闭屏幕更新End Sub'以下的循环过程,也用于批量打印,Z的值可以是Z=1 TO 5(1到5),也可是单元格的内容Sub 批量打印()For Z = Cells(1, 11) To Cells(1, 12) '变量X的值从打印起始号K1到结束号L1之间逐渐递增Cells(1, 13) = Z 'M1的值等于变量XEnd Sub'以下是将打印情况写入工作表的宏Sub 打印信息()Application.ScreenUpdating = False '关闭屏幕更新Dim Y '声明变量Y = '判定活动工作表名称Sheets("打印信息").SelectX = 3 '从第3行开始Do While Not (IsEmpty(Cells(X, 2).Value)) '判断第1列的最后一行(即空行的上一行)X = X + 1 '在最后一行加一行即为空行LoopCells(X, 2) = Cells(2, 1)Cells(X, 3) = Sheets(Y).Cells(4, 3)Cells(2, 1) = Cells(2, 1) + 1Cells(X, 4) = Sheets(Y).Cells(1, 4)Cells(X, 5) = Sheets(Y).Cells(1, 5)[c1] = YSheets(Y).Select '返回上一次打开的工作表Application.ScreenUpdating = True '打开屏幕更新End Sub将文件保存为以某一单元格中的值为文件名的宏怎么写假设你要以Sheet1的A1单元格中的值为文件名保存，则应用命令：ActiveWorkbook.SaveCopyAs Str(Range("Sheet1!A1")) + ".xls"在Excel中,如何用程式控制某一单元格不可编辑修改?thanks Private Sub Workbook_Open()ProtectSpecialRange ("A1")Sub ProtectSpecialRange(RangeAddress As String)On Error Resume NextWith Sheet1.Cells.Locked = False.Range(RangeAddress).Locked = True.Protection.AllowEditRanges.Add Title:="区域1", Range:=Range(RangeAddress) _, Password:="pass".Protect DrawingObjects:=True, Contents:=True, Scenarios:=TrueEnd WithEnd Sub对工作表编程，有时要判断工作表的记录总数，VBA里如何实现？x=1do while not (isempty(sheets("").cells(x,1).value)x=x+1loop在VBA中等同于EXCELE中的求和函数-sum()-的函数是什么?Application.WorksheetFunction.Sum()自定义菜单有三个菜单项，要求手工顺序执行，电脑资料《各种Excel VBA的命令2》(https://www.)。

excel锁定公式Excel是一款非常好用的办公软件，它的出现使很多工作的数据处理、统计和报表的制作变得非常容易，也节省了很多劳动力。

在经常使用Excel的过程中，我们可能会遇到一些比较麻烦的问题，比如：“我写了一个公式，怎么办，让它不被其他人修改？”、“我输入数据时，公式没有及时自动计算，有什么办法解决？”等等。

这其实是一个“Excel锁定公式”的问题。

首先，什么是“Excel锁定公式”。

通俗来说，就是指在Excel表格中，可以让Excel自动计算公式的结果，且把公式的值锁定在某一单元格，不允许其他人更改或删除公式。

其实，锁定Excel公式的方法很多，本文将为大家介绍几种比较常用的方法：1. 使用“单元格保护”功能：单元格保护功能可以防止其他人修改某些单元格。

在Excel中，点击“审阅”按钮，点击“单元格保护”，就可以弹出“单元格保护”对话框。

在此对话框中，勾选“保护细胞”，然后点击“确定”按钮，这时，Excel中的一些单元格就已经锁定，不允许修改或删除。

2. 使用“自动计算”设置：在Excel中，可以通过设置“自动计算”，让Excel自动计算某些单元格中的公式，从而锁定公式，使得公式不能被其他人修改或删除。

设置“自动计算”步骤如下：点击“开发工具”按钮，点击“宏设置”，在“自动计算”选项中，勾选“自动计算”，点击“确定”按钮，这样，Excel中选中的单元格中的公式就被锁定，不能被其他人修改或删除。

3. 使用“冻结面板”设置：如果要将多个单元格的公式锁定，可以使用“冻结面板”设置，从而锁定计算的单元格。

使用“冻结面板”的步骤如下：点击“开发工具”按钮，点击“冻结面板”，然后点击“选择冻结”，选择要锁定单元格所在的行或列，点击“确定”按钮，这时，所选择的单元格就被冻结，不允许其他人修改或删除公式。

如果要对Excel公式进行锁定处理，可以根据自己的实际情况，选取合适的方法，例如上述提到的3种方法中的一种或多种方法。

excel vba锁单元格公式Excel VBA锁定单元格公式的实现方法在Excel中，我们经常需要对一些单元格进行保护，以避免误操作导致公式或数据的错误修改。

然而，在某些情况下，我们可能希望只保护单元格的内容，而不保护公式，从而允许用户修改公式。

在这种情况下，Excel VBA提供了一种锁定单元格公式的实现方法。

以下是实现此功能的步骤：1. 打开Excel，并按下ALT + F11打开Visual Basic for Applications2. 在左侧的"项目浏览"窗格中，双击以打开目标工作簿的VBA项目3. 在左侧的"工程资源管理器"窗格中，找到并双击该工作簿的"这工作簿"对象4. 在新窗口的代码窗口中，粘贴以下代码：```Private Sub Workbook_Open()Sheets("Sheet1").Unprotect ' 如果需要，请将"Sheet1"更改为目标工作表的名称Sheets("Sheet1").Range("A1:B10").Locked = True ' 如果需要，请将"A1:B10"更改为目标单元格的范围Sheets("Sheet1").Protect ' 如果需要，请使用其他的保护选项End Sub```5. 根据需要，修改代码中的工作表名称和目标单元格范围6. 按下F5运行代码，关闭VBA编辑器7. 保存工作簿，并重新打开它运行以上代码后，Excel会在打开工作簿时触发Workbook_Open事件，自动保护指定的工作表，并锁定指定的单元格。

这样，用户将无法修改锁定的单元格，但仍然可以编辑其他未锁定的单元格，包括公式。

需要注意的是，锁定公式的功能只能在工作簿打开时触发，所以用户可能需要重新打开工作簿以使其生效。

保护工作表里的公式
保护工作表里的公式是为了防止公式被修改或删除，可以采取以下几种方法：
1. 锁定公式：在Excel中，可以使用“审阅”选项卡中的“保护工作表”功能，选择“锁定单元格”和“选定锁定单元格”，这样就可以防止公式被修改或删除。

2. 将公式设置为只读：在Excel中，可以使用“文件”选项卡中的“信息”功能，选择“保护工作簿”，然后选择“保护当前工作表”，将公式设置为只读，这样也可以防止公式被修改或删除。

3. 使用VBA宏：在Excel中，可以使用VBA宏来保护工作表里的公式。

例如，可以使用以下代码来保护工作表里的公式：
```vba
Sub ProtectFormulas()
Dim ws As Worksheet
Dim rng As Range
' 遍历工作表中的所有单元格
For Each ws In
For Each rng In
' 如果单元格包含公式，则将其设置为只读
If IsNumeric() And = Then
= True
End If
Next rng
Next ws
End Sub
```
以上方法都可以有效地保护工作表里的公式，防止被修改或删除。

executeexcel4macro function -回复如何使用executeexcel4macro函数进行Excel宏的执行。

本文将介绍executeexcel4macro函数的基本概念、语法和用法，并通过示例详细说明如何使用该函数执行Excel宏。

在Excel中，宏是一种自动化操作的方式，可以通过录制宏或编写宏代码来实现。

有时候，在VBA代码中执行宏可能不太方便或不可行，这时可以使用executeexcel4macro函数来执行Excel宏。

executeexcel4macro函数是Excel4宏语言中的一个函数，用于执行Excel中的宏命令。

它的语法如下：`EXECUTEEXCEL4MACRO("宏命令")`其中，“宏命令”是一个字符串，用于指定要执行的宏命令。

使用executeexcel4macro函数执行Excel宏是一种非常强大和灵活的方式。

下面通过一个示例来详细说明如何使用executeexcel4macro函数执行Excel宏。

假设在Excel中有一个宏，用于实现某个复杂的计算操作。

我们可以通过执行宏来自动执行这个操作。

首先，我们需要将宏命令保存到一个单元格中。

假设我们将宏命令保存在单元格A1中。

然后，在另一个单元格中使用executeexcel4macro函数来执行宏命令。

假设我们将这个函数保存在单元格B1中。

那么，B1单元格的公式将为：`=EXECUTEEXCEL4MACRO(A1)`在输入这个公式后，Excel会自动执行宏命令，并显示执行结果。

需要注意的是，宏命令必须使用Excel4的宏语言编写，而不能使用VBA 语言。

Excel4的宏语言比较简单，但功能也相对有限。

所以，在编写宏命令时需要注意其语法和限制。

另外，executeexcel4macro函数只能执行Excel中已存在的宏，无法创建新的宏。

如果需要创建新的宏，可以使用VBA语言编写宏代码，并通过其他方式来执行。

Excel工作表的保护大法：用宏进行加密Excel表格是我们工作中经常用到的，而它往往涉及统计数据等敏感问题，因此，Excel表格的保护也是经常遇到的问题，如何安全使用Excel呢？我们常用到的是Excel“工具”菜单提供的“保护工作表”和“保护工作簿”功能。

有没有其他方法呢？用宏进行“显式”加密在需要加密的Excel 表中，点击[工具]→[宏]→[Visual Basic编辑器]，打开“工程资源管理器”，双击该工作表，在右边的是设置该表属性的编辑窗口，单击该窗口左上方的下拉列表框，选择Worksheet，再从该窗口右上方的列表框中选择Activate(激活)（如图）。

添加如下代码：（假设“123”为密码，Sheet1为限制权限表格，Sheet2为工作簿中为任何适合的工作表）Private Sub Worksheet_Activate()Sheets("sheet1").Cells.Font.ColorIndex = 2 '设置文字颜色为白色If Application.InputBox("请输入密码:") = 123 ThenRange("A1").SelectActiveSheet.Cells.Font.ColorIndex = 56' 设置文字颜色为黑色ElseMsgBox "密码错误，即将退出!"Sheets("sheet2").SelectEnd IfEnd Sub每次当你选择该“加密”表的时候都会弹出对话框要求输入密码，正确则进入该表（Sheet1），否则会选择其他表（Sheet2）。

用宏进行“隐式”加密“显式”加密，虽然可以让没有密码的使用者无法看到“加密”表格，但是每次选择该表格时都会弹出对话框，实在不方便而且给其他用户一种被防范的不舒服感觉。

于是笔者就想出了下面的“隐式”加密方法。

Excel使用技巧如何利用VBA宏实现自动化数据处理在日常的工作中，我们经常需要处理大量的数据。

而Excel作为一款强大的办公软件，提供了丰富的功能和工具，可以帮助我们更高效地处理数据。

其中，VBA宏是Excel的一个重要功能，可以帮助我们实现自动化数据处理。

本文将介绍一些Excel使用技巧，并演示如何利用VBA宏来实现自动化数据处理。

一、Excel使用技巧1. 快速插入数据：在Excel中，我们可以使用快捷键Ctrl+Enter来快速插入一列或一行数据。

只需先选中一列或一行，然后输入数据，按下快捷键即可。

2. 数据筛选与排序：Excel提供了数据筛选和排序功能，可以帮助我们快速找到需要的数据。

在Excel的菜单栏中，选择“数据”-“排序”或“筛选”，即可使用这些功能。

3. 公式的使用：Excel的公式是数据处理中的重要工具。

我们可以使用各种函数来进行数值计算、逻辑判断、日期处理等。

例如，SUM函数可以用于求和，IF函数可以用于条件判断等。

4. 图表的制作：图表可以帮助我们更直观地呈现数据。

在Excel中，我们可以使用图表功能来创建各种类型的图表，如柱状图、折线图、饼图等。

二、利用VBA宏实现自动化数据处理VBA（Visual Basic for Applications）是一种编程语言，可以帮助我们通过编写程序来操作Excel。

下面以一个例子来演示如何利用VBA宏来实现自动化数据处理。

假设我们有一个包含销售数据的Excel表格，其中包括商品名称、销售数量和销售金额等信息。

我们希望根据销售数量和销售金额来计算每个商品的销售额，并将结果显示在另一个表格中。

首先，我们打开Excel，并按下Alt+F11快捷键，打开VBA编辑器。

然后，在左侧的“项目资源管理器”中，双击打开Excel对象。

接下来，我们在VBA编辑器的代码窗口中编写以下代码：```vbaSub CalculateSales()Dim LastRow As LongDim i As LongLastRow = Cells(Rows.Count, 1).End(xlUp).RowFor i = 2 To LastRowCells(i, 4).Value = Cells(i, 2).Value * Cells(i, 3).ValueNext iEnd Sub```以上代码中，我们首先声明了两个变量LastRow和i，分别用于记录表格最后一行的行数和循环计数器。

如何锁定EXCEL表格中的公式需要分三大步骤完成：1、全部选中工作表→右击→设置单元格格式→保护→去掉“锁定”前方框中的√→确定（此步骤是为了设置保护后可以编辑其他单元格）2、选中要保护的公式所在单元格→重复以上过程→在“锁定”前方框中加上“√”；（此步骤是为了设置保护公式所在单元格）3、工具→保护→保护工作表→设置密码（两次，也可以不设）→确定。

注：需要修改公式时→工具→保护→撤销工作表保护隔离求和=SUMPRODUCT((MOD(COLUMN(A1:Z1),3)=1)*A1:Z1)给出的公式的范围是A到Z列，隔3列求和。

具体根据你自己的情况修改。

多条件求和一、反复筛选法Excel中通过筛选是可以把符合条件的数据单独显示出来的。

先点击功能区“数据”选项卡中的“筛选”按钮，那么标题栏每一单元格均添加下拉按钮。

点击“班级”（A1）单元格下拉按钮，在弹出的菜单下方取消选择“全选”复选项，然后再选中“5班”复选项。

如图2所示。

确定后显示出来的就只有5班学生的成绩了。

再点击D1单元格下拉按钮，在弹出菜单中选择“数字筛选→小于或等于”命令，如图3所示，打开“自定义自动筛选方式”对话框，在“小于或等于”后的输入框中输入数字“20”，如图4所示。

确定后，显示出来的就是5班中语文名次小于等于20的所有学生了。

用同样的方法再筛选显示数学名次小于等于20的学生，那么在屏幕中显示的就是我们所需要的学生了。

选中显示出来的学生的总分及下方的一个空单元格（放置求和结果），再点击功能区“公式”选项卡中的“自动求和”按钮右侧的小三角，在弹出的菜单中点击“求和”命令，就可以把他们的总分加起来了，如图5所示。

二、条件求和法Excel 2007其实自带了一个多条件求和的工具。

但是默认状态下没有安装。

我们需要自行加载。

先点击左上角“Microsoft Office 按钮”，单击右下方“Excel选项”按钮。

在打开的“Excel选项”对话框中点击左侧的“加载项”按钮，然后在右侧下方“管理”框中，选择“Excel加载项”并点击“转到”按钮，如图6所示。