EXCEL宏编辑命令(8)

End Sub

109、选择到指定列的最后行

Sub 选择到指定列的最后行()

Range(\End Sub

110、将Sheet1的A列的非空值写到Sheet2的A列

Sub 将Sheet1的A列的非空值写到Sheet2的A列()

Sheet1.Columns(\End Sub

111、将名称1的数据写到名称2

Sub Macro2()

Range(\位置2\位置1\alue End Sub

112、单元反选

Sub 单元反选()

Application.DisplayAlerts = False Application.ScreenUpdating = False

Dim raddress As String, taddress As String raddress = Selection.Address

taddress = ActiveSheet.UsedRange.Address With Sheets.Add .Range(taddress) = 0

.Range(raddress) = \

raddress = .Range(taddress).SpecialCells(xlCellTypeConstants, 1).Address .Delete

End With

ActiveSheet.Range(raddress).Select Application.ScreenUpdating = True End Sub

113、调整选中对象中的文字

Sub 调整选中对象中的文字() '文字居中、自动调整大小

With Selection

.HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .ReadingOrder = xlContext .Orientation = xlHorizontal .AutoSize = True .AddIndent = False End With End Sub

114、去除指定范围内的对象

Sub 去除指定范围内的对象() Dim p As Shape

Set My = Worksheets(\工作表名\

For Each p In My.Shapes

If Not Application.Intersect(p.TopLeftCell, Range(\范围\ Next End Sub

115、更新透视表数据项

Sub DeleteMissingItems2002All()

'防止数据透视表中显示无用的数据项 '在 Excel 2002 或更高版本中 '如果无用的数据项已经存在, '运行这个宏可以更新 Dim pt As PivotTable Dim ws As Worksheet

For Each ws In ActiveWorkbook.Worksheets For Each pt In ws.PivotTables

pt.PivotCache.MissingItemsLimit = xlMissingItemsNone Next pt Next ws End Sub

116、将全部工作表名称写到A列

Sub 将全部表名称写到A列()

k = 1

For Each Sht In Sheets

Cells(k + 1, 1) = Sht.Name '指定写入的行和列 k = k + 1 Next End Sub

117、为当前选定的多单元插入指定名称

Sub 为当前选定的多单元插入指定名称()

Selection.Name = \临时\

ActiveWorkbook.Names.Add Name:=\临时\End Sub

118、删除全部名称

Sub 删除全部名称() On Error Resume Next

Dim l As Integer

l = ActiveWorkbook.Names.Count For i = l To 1 Step -1

ActiveWorkbook.Names(i).Delete Next End Sub

119、以指定区域为表目录补充新表

Sub 以指定区域为表目录补充新表() Dim dic As Object, sh As Worksheet Dim arr, item

arr = Range(\

Set dic = CreateObject(\ For Each sh In ThisWorkbook.Worksheets dic.Add sh.Name, \ Next

For Each item In arr

If item <> \ With ThisWorkbook.Worksheets.Add .Name = item End With

'或者换用这行代码也可以 End If

Next

Set dic = Nothing End Sub

120、按A列数据批量修改表名称

Sub 按A列数据批量修改表名称() Dim i%

For i = 1 To Sheets.Count - 1

Sheets(i).Name = Cells(i + 1, 1).Text Next End Sub

121、按A列数据批量创建新表(控件按钮代码)

Private Sub CommandButton1_Click() On Error Resume Next Dim i%, j%

For i = 1 To [a65536].End(xlUp).Row For j = 2 To Sheets.Count

If Cells(i, 1) = Sheets(j).Name Then Exit For End If

Next

Sheets.Add(after:=Sheets(Sheets.Count)).Name = Cells(i, 1) Next End Sub

122、清除剪贴板

Sub 清除剪贴板()

Application.CutCopyMode = False

Application.CommandBars(\isible = False End Sub

123、批量清除软回车

Sub 批量清除软回车()

'也可直接使用Alt+10或13替换

Cells.Replace What:=Chr(10), Replacement:=\

xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False End Sub

124、判断指定文件是否已经打开

Sub 判断指定文件是否已经打开()

Dim x As Integer

For x = 1 To Workbooks.Count

If Workbooks(x).Name = \函数.xls\ '文件名称 MsgBox \文件已打开\ Exit Sub End If Next

MsgBox \文件未打开\End Sub

125、当前文件另存到指定目录

Sub 当前激活文件另存到指定目录()

ActiveWorkbook.SaveAs Filename:=\信件\\\End Sub

126、另存指定文件名

Sub 另存指定文件名()

ActiveWorkbook.SaveAs ThisWorkbook.Path & \别名.xls\End Sub

127、以本工作表名称另存文件到当前目录

Sub 以本工作表名称另存文件到当前目录()

ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & \End Sub

128、将本工作表单独另存文件到Excel当前默认目录

Sub 将本工作表单独另存文件到Excel当前默认目录()

ActiveSheet.Copy

ActiveWorkbook.SaveAs Filename:=ActiveSheet.Name & \

百度搜索“77cn”或“免费范文网”即可找到本站免费阅读全部范文。收藏本站方便下次阅读，免费范文网，提供经典小说综合文库EXCEL宏编辑命令(8)在线全文阅读。