loading
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 批量添加文本() Dim s As Range
For Each s In Selection s = s & \文本内容\ Next End Sub
39：不连续区域插入文本
Sub 批量插入文本() Dim s As Range
For Each s In Selection s = \文本内容\ Next End Sub
40：从指定位置向下同时录入多单元指定内容
Sub 从指定位置向下同时录入多单元指定内容() Dim arr
arr = Array(\
[B2].Resize(8, 1) = Application.WorksheetFunction.Transpose(arr) End Sub
41：按aa工作表A列的内容排列工作表标签顺序
Sub 按aa工作表A列的内容排列工作表标签顺序() Dim I%, str1$ I = 1
Sheets(\
Do While Cells(I, 1).Value <> \ str1 = Trim(Cells(I, 1).Value) Sheets(str1).Select
Sheets(str1).Move after:=Sheets(I) I = I + 1
Sheets(\ Loop End Sub
42：以A1单元文本作表名插入工作表
Sub 以A1单元文本作表名插入工作表() Dim nm As String nm = [a1] Sheets.Add
ActiveSheet.Name = nm End Sub
43：删除所有未选定工作表
Sub 删除所有未选定工作表()
Dim sht As Worksheet, n As Integer, iFlag As Boolean Dim ShtName() As String
n = ActiveWindow.SelectedSheets.Count ReDim ShtName(1 To n) n = 1
For Each sht In ActiveWindow.SelectedSheets ShtName(n) = sht.Name n = n + 1 Next
Application.DisplayAlerts = False For Each sht In Sheets iFlag = False For i = 1 To n - 1
If ShtName(i) = sht.Name Then iFlag = True Exit For End If Next
If Not iFlag Then sht.Delete Next
Application.DisplayAlerts = True End Sub
44：工作表标签排序
Sub 工作表标签排序()
Dim i As Long, j As Long, nums As Long, msg As Long
msg = MsgBox(\工作表按升序排列请选 '是[Y]'. \工作表按降序排列请选 '否[N]'\工作表排序\ If msg = vbCancel Then Exit Sub nums = Sheets.Count
If msg = vbYes Then 'Sort ascending For i = 1 To nums For j = i To nums
If UCase(Sheets(j).Name) < UCase(Sheets(i).Name) Then Sheets(j).Move Before:=Sheets(i) End If Next j Next i
Else 'Sort descending For i = 1 To nums For j = i To nums
If UCase(Sheets(j).Name) > UCase(Sheets(i).Name) Then Sheets(j).Move Before:=Sheets(i) End If Next j Next i End If End Sub
259个常用宏-excelhome(2) 2009-08-15 14:11:45
45：定义指定工作表标签颜色
Sub 定义指定工作表标签颜色()
Sheets(\End Sub
46：在目录表建立本工作簿中各表链接目录
Sub 在目录表建立本工作簿中各表链接目录() Dim s%, Rng As Range On Error Resume Next Sheets(\目录\ If Err = 0 Then
Sheets(\目录\ Else
Sheets.Add
ActiveSheet.Name = \目录\ End If
For i = 1 To Sheets.Count
If Sheets(i).Name <> \目录\ s = s + 1
Set Rng = Sheets(\目录\