EXCEL宏代码大全

EXCEL宏代码大全本文件部分文章来源于网络，文章版权归原作者所有，如果本站转载的文章侵犯了您的权益请及时联系我们，我们将尽快妥善处理。本站除部分特别声明禁止转载的专稿外，其他文章可以自由转载，但请务必注明原出处和作者。000.A列半角内容变红SubA列半角内容变红()?DimrgAsRange,iAsLong?Application.ScreenUpdating=False?ForEachrgInCells.SpecialCells(xlCellTypeConstants,3)???Fori=1ToLen(rg)?????IfAsc(Mid(rg,i,1))001.A列等于A列减B列SubA列等于A列减B列()Fori=1To23Cells(i,1)=Cells(i,1)-Cells(i,2)NextEndSub002.B列录入数据时在A列返回记录时间（工作表代码）PublicSubWorksheet_Change(ByValTargetAsRange)IfTarget.Column=2ThenTarget.Offset(,-1)=NowEndIfEndSub003.Excel宏常用代码本大类暂没有内容，以下是关于本类的所有记录集。004.Sub以当前日期为名称另存文件()ActiveWorkbook.SaveAsFilename:=Date&.xlsEndSub005.Sub启用保存()Application.CommandBars(File).Controls(4).Enabled=TrueApplication.CommandBars(File).Controls(5).Enabled=TrueEndSub006.Sub执行前需要验证密码的宏()IfInputBox(请输入您的使用权限:,系统提示)=123Then重排窗口'要执行的宏代码或宏名称ElseMsgBox对不起,您没有使用该宏的权限,按确定键后退出!EndIfEndSub007.Sub选择第5行开始所有数据行B()Rows(5:&Cells.Find(*,,,,1,2).Row).SelectEndSub008.VBA返回公式结果SubVBA返回公式结果()x=Application.WorksheetFunction.Sum(Range(a2:a100))Range(B1)=xEndSub009.不连续区域录入对勾Sub批量录入对勾()Selection.FormulaR1C1=√EndSub010.不连续区域录入当前单元地址Sub区域录入当前单元地址()ForEachmycellInSelectionmycell.FormulaR1C1=mycell.AddressNextEndSub011.不连续区域录入当前数字日期Sub区域录入当前数字日期()Selection.FormulaR1C1=Format(Now(),yyyymmdd)EndSub012.不连续区域录入当前文件名Sub批量录入当前文件名()Selection.FormulaR1C1=ThisWorkbook.NameEndSub013.不连续区域录入当前日期Sub区域录入当前日期()Selection.FormulaR1C1=Format(Now(),yyyy-m-d)EndSub014.不连续区域录入当前日期和时间Sub区域录入当前日期和时间()Selection.FormulaR1C1=Format(Now(),yyyy-m-dh:mm:ss)EndSub015.不连续区域插入当前文件名和表名及地址Sub批量插入当前文件名和表名及地址()ForEachmycellInSelectionmycell.FormulaR1C1=[+ActiveWorkbook.Name+]+ActiveSheet.Name+!+mycell.AddressNextEndSub016.不连续区域插入文本Sub批量插入文本()DimsAsRangeForEachsInSelections=文本内容&sNextEndSub017.不连续区域添加文本Sub批量添加文本()DimsAsRangeForEachsInSelections=s&文本内容NextEndSub018.为当前选定的多单元插入指定名称Sub为当前选定的多单元插入指定名称()Selection.Name=临时ActiveWorkbook.Names.AddName:=临时,RefersTo:=Selection'或者换用这行代码也可以EndSub019.为指定工作表加指定密码保护表Sub为指定工作表加指定密码保护表()Sheet10.ProtectPassword:=123EndSub020.为指定工作表设置滚动范围（工作簿代码）PrivateSubWorkbook_SheetSelectionChange(ByValShAsObject,ByValTargetAsRange)Sheet1.ScrollArea=A1:M30EndSub021.从指定位置向下同时录入多单元指定内容Sub从指定位置向下同时录入多单元指定内容()Dimarrarr=Array(1,2,13,25,46,12,0,20)[B2].Resize(8,1)=Application.WorksheetFunction.Transpose(arr)EndSub022.以A1单元内容批量插入批注Sub以A1单元内容批量插入批注()DimrAsRangeIfSelection.Cells.Count0ThenForEachrInSelectionr.AddCommentr.Comment.Visible=Falser.Comment.TextText:=[a1].TextNextEndIfEndSub023.以A1单元文本作表名插入工作表Sub以A1单元文本作表名插入工作表()DimnmAsStringnm=[a1]Sheets.AddActiveSheet.Name=nmEndSub024.以当前日期为新文件名另存文件Sub以当前日期为新文件名另存文件()ThisWorkbook.SaveAsThisWorkbook.Path&\&Format(Now(),yyyymmdd)&.xlsEndSub025.以当前日期和时间为新文件名另存文件Sub以当前日期和时间为新文件名另存文件()ThisWorkbook.SaveAs