EXCEL宏代码大全

1、EXCEL宏代码大全 本文件部分文章来源于网络，文章版权归原作者所有，如果本站转载的文章侵犯了您的权益请及时联系我们，我们将尽快妥善处理。本站除部分特别声明禁止转载的专稿外，其他文章可以自由转载，但请务必注明原出处和作者。 000. A列半角内容变红 Sub A列半角内容变红() ? Dim rg As Range, i As Long ? Application.ScreenUpdating = False ? For Each rg In Cells.SpecialCells(xlCellTypeConstants, 3) ? For i = 1 To Len(rg) ? If Asc(M

2、id(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 If End Sub 003. Excel宏常用代码 本大类暂没有内容，以下是关于本类的所有记录集。

3、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(请输入您的使用权限:, 系统提示) = 123 Then 重排窗口 要执行的宏代码或宏名称 Else

4、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. 不连续区域录入对勾 Sub 批量录入对勾() Selection.FormulaR1C1 = End Sub 010. 不连

5、续区域录入当前单元地址 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.FormulaR1C1 = ThisWorkbook.Name End Sub 013. 不连续区域录入当前日期

6、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 mycell.FormulaR1C1 = + ActiveWorkbook.Name + + Activ

7、eSheet.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. 为当前选定的多单元插入指定名称 Sub 为当前选定的多单元插入指定名称() Selection.Name = 临时 Activ

8、eWorkbook.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 As Range) Sheet1.ScrollArea = A1:M30 End Sub 021. 从

9、指定位置向下同时录入多单元指定内容 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 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 以当前日期为新文件名另存