19、返回光标所在行数

Sub 返回光标所在行数() x = ActiveCell.Row Range(\End Sub

20、在A1返回当前选中单元格数量

Sub 在A1返回当前选中单元格数量() [A1] = Selection.Count End Sub

21、返回当前工作簿中工作表数量

Sub 返回当前工作簿中工作表数量() t = Application.Sheets.Count MsgBox t End Sub

22、返回光标选择区域的行数和列数

Sub 返回光标选择区域的行数和列数() x = Selection.Rows.Count y = Selection.Columns.Count Range(\ Range(\End Sub

23、工作表中包含数据的最大行数

Sub 包含数据的最大行数()

n = Cells.Find(\ MsgBox n End Sub

24、返回A列数据的最大行数

Sub 返回A列数据的最大行数()

n = Range(\ Range(\End Sub

25、将所选区域文本插入新建文本框

Sub 将所选区域文本插入新建文本框() For Each rag In Selection

n = n & rag.Value & Chr(10) Next

ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, ActiveCell.Width, ActiveCell.Top + ActiveCell.Height, 250#, 100).Select Selection.Characters.Text = \问题：\

With Selection.Characters(Start:=1, Length:=3).Font .Name = \黑体\ .FontStyle = \常规\ .Size = 12 End With End Sub

ActiveCell.Left +

26、批量插入地址批注

Sub 批量插入地址批注() On Error Resume Next Dim r As Range

If Selection.Cells.Count > 0 Then For Each r In Selection r.Comment.Delete r.AddComment

r.Comment.Visible = False

r.Comment.Text Text:=\本单元格：\ Next End If End Sub

27、批量插入统一批注

Sub 批量插入统一批注()

Dim r As Range, msg As String

msg = InputBox(\请输入欲批量插入的批注\提示\随便输点什么吧\ If Selection.Cells.Count > 0 Then For Each r In Selection r.AddComment

r.Comment.Visible = False r.Comment.Text Text:=msg Next End If

End Sub

28、以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

29、不连续区域插入当前文件名和表名及地址

Sub 批量插入当前文件名和表名及地址() For Each mycell In Selection

mycell.FormulaR1C1 = \+ ActiveWorkbook.Name + \+ ActiveSheet.Name + \+ mycell.Address Next End Sub

30、不连续区域录入当前单元地址

Sub 区域录入当前单元地址() For Each mycell In Selection

mycell.FormulaR1C1 = mycell.Address Next End Sub

31、连续区域录入当前单元地址

Sub 连续区域录入当前单元地址()

Selection = \ Selection.Copy

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End Sub

32、返回当前单元地址

Sub 返回当前单元地址() d = ActiveCell.Address [A1] = d End Sub

33、不连续区域录入当前日期

Sub 区域录入当前日期()

Selection.FormulaR1C1 = Format(Now(), \End Sub

34、不连续区域录入当前数字日期

Sub 区域录入当前数字日期()

Selection.FormulaR1C1 = Format(Now(), \End Sub

35、不连续区域录入当前日期和时间

Sub 区域录入当前日期和时间()

Selection.FormulaR1C1 = Format(Now(), \End Sub

36、不连续区域录入对勾

Sub 批量录入对勾()

Selection.FormulaR1C1 = \√\End Sub

37、不连续区域录入当前文件名

Sub 批量录入当前文件名()

Selection.FormulaR1C1 = ThisWorkbook.Name End Sub

38、不连续区域添加文本

Sub 批量添加文本()