《excel代码大全(9页).doc》由会员分享，可在线阅读，更多相关《excel代码大全(9页).doc（9页珍藏版）》请在taowenge.com淘文阁网|工程机械CAD图纸|机械工程制图|CAD装配图下载|SolidWorks_CaTia_CAD_UG_PROE_设计图分享下载上搜索。
1、-excel代码大全.txt第一次笑是因为遇见你，第一次哭是因为你不在，第一次笑着流泪是因为不能拥有你。EXCEL宏代码大全 本文件部分文章来源于网络，文章版权归原作者所有，如果本站转载的文章侵犯了您的权益请及时联系我们，我们将尽快妥善处理。本站除部分特别声明禁止转载的专稿外，其他文章可以自由转载，但请务必注明原出处和作者。 000. A列半角内容变红 Sub A列半角内容变红() ? Dim rg As Range, i As Long ? Application.ScreenUpdating = False ? For Each rg In Cells.SpecialCells(xlCel
2、lTypeConstants, 3) ? For i = 1 To Len(rg) ? If Asc(Mid(rg, i, 1) 001. A列等于A列减B列 Sub A列等于A列减B列() For i = 1 To 23 Cells(i, 1) = Cells(i, 1) - Cells(i, 2) Next End Sub 002. B列录入数据时在A列返回记录时间（工作表代码） Public Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 2 Then Target.Offset(, -1) = Now End
3、 If End Sub 003. Excel宏常用代码 本大类暂没有内容，以下是关于本类的所有记录集。 004. Sub 以当前日期为名称另存文件() ActiveWorkbook.SaveAs Filename:=Date & .xls End Sub 005. Sub 启用保存() Application.CommandBars(File).Controls(4).Enabled = True Application.CommandBars(File).Controls(5).Enabled = True End Sub 006. Sub 执行前需要验证密码的宏() If InputBox
4、(请输入您的使用权限:, 系统提示) = 123 Then 重排窗口 要执行的宏代码或宏名称 Else MsgBox 对不起,您没有使用该宏的权限,按确定键后退出! End If End Sub 007. Sub 选择第5行开始所有数据行B() Rows(5: & Cells.Find(*, , , , 1, 2).Row).Select End Sub 008. VBA返回公式结果 Sub VBA返回公式结果() x = Application.WorksheetFunction.Sum(Range(a2:a100) Range(B1) = x End Sub 009. 不连续区域录入对勾
5、Sub 批量录入对勾() Selection.FormulaR1C1 = End Sub 010. 不连续区域录入当前单元地址 Sub 区域录入当前单元地址() For Each mycell In Selection mycell.FormulaR1C1 = mycell.Address Next End Sub 011. 不连续区域录入当前数字日期 Sub 区域录入当前数字日期() Selection.FormulaR1C1 = Format(Now(), yyyymmdd) End Sub 012. 不连续区域录入当前文件名 Sub 批量录入当前文件名() Selection.Formu
6、laR1C1 = ThisWorkbook.Name End Sub 013. 不连续区域录入当前日期 Sub 区域录入当前日期() Selection.FormulaR1C1 = Format(Now(), yyyy-m-d) End Sub 014. 不连续区域录入当前日期和时间 Sub 区域录入当前日期和时间() Selection.FormulaR1C1 = Format(Now(), yyyy-m-d h:mm:ss) End Sub 015. 不连续区域插入当前文件名和表名及地址 Sub 批量插入当前文件名和表名及地址() For Each mycell In Selection
7、mycell.FormulaR1C1 = + ActiveWorkbook.Name + + ActiveSheet.Name + ! + mycell.Address Next End Sub 016. 不连续区域插入文本 Sub 批量插入文本() Dim s As Range For Each s In Selection s = 文本内容 & s Next End Sub 017. 不连续区域添加文本 Sub 批量添加文本() Dim s As Range For Each s In Selection s = s & 文本内容 Next End Sub 018. 为当前选定的多单元插入
8、指定名称 Sub 为当前选定的多单元插入指定名称() Selection.Name = 临时 ActiveWorkbook.Names.Add Name:=临时, RefersTo:=Selection 或者换用这行代码也可以 End Sub 019. 为指定工作表加指定密码保护表 Sub 为指定工作表加指定密码保护表() Sheet10.Protect Password:=123 End Sub 020. 为指定工作表设置滚动范围（工作簿代码） Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target
9、 As Range) Sheet1.ScrollArea = A1:M30 End Sub 021. 从指定位置向下同时录入多单元指定内容 Sub 从指定位置向下同时录入多单元指定内容() Dim arr arr = Array(1, 2, 13, 25, 46, 12, 0, 20) B2.Resize(8, 1) = Application.WorksheetFunction.Transpose(arr) End Sub 022. 以A1单元内容批量插入批注 Sub 以A1单元内容批量插入批注() Dim r As Range If Selection.Cells.Count 0 Then
10、 For Each r In Selection r.AddComment r.Comment.Visible = False r.Comment.Text Text:=a1.Text Next End If End Sub 023. 以A1单元文本作表名插入工作表 Sub 以A1单元文本作表名插入工作表() Dim nm As String nm = a1 Sheets.Add ActiveSheet.Name = nm End Sub 024. 以当前日期为新文件名另存文件 Sub 以当前日期为新文件名另存文件() ThisWorkbook.SaveAs ThisWorkbook.Path & & Format(Now(), yyyymmdd) & .xls End Sub 025. 以当前日期和时间为新文件名另存文件 Sub 以当前日期和时间为新文件名另存文件() ThisWorkbook.SaveAs 第 9 页-