Office办公软件实例教程(二)

20.批量插入当前文件名和表名及地址Sub批量插入当前文件名和表名及地址()

ForEachmycellInSelection

mycell.FormulaR1C1=\"[\"+ActiveWorkbook.Name+\"]\"+

ActiveSheet.Name+\"!\"+mycell.Address

NextEndSub

21.区域录入当前单元地址Sub区域录入当前单元地址()

Selection=\"=ADDRESS(ROW(),COLUMN(),4,1)\"Selection.Copy

Selection.PasteSpecialPaste:=xlPasteValues,Operation:=xlNone,

SkipBlanks_

:=False,Transpose:=False

EndSub

22.区域录入当前日期Sub区域录入当前日期()

思颐集团电商事业部务实第40页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

WithApplication

.Calculation=xlManual.MaxChange=0.001EndWith

ActiveWorkbook.PrecisionAsDisplayed=FalseSelection=\"=TEXT(NOW(),\"\"yyyy-m-d\"\")\"Selection.Copy

Selection.PasteSpecialPaste:=xlPasteValues,Operation:=xlNone,

SkipBlanks_

:=False,Transpose:=False

Windows.ArrangeArrangeStyle:=xlCascadeApplication.CutCopyMode=False

WithApplication

.Calculation=xlAutomatic.MaxChange=0.001EndWith

ActiveWorkbook.PrecisionAsDisplayed=FalseEndSub

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

思颐集团电商事业部务实第41页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

Selection=

\"=VALUE(YEAR(TODAY())&RIGHT(MONTH(TODAY())+100,2)&RIGHT(DAY(TODAY())+100,2))\"

Selection.Copy

Selection.PasteSpecialPaste:=xlPasteValues,Operation:=xlNone,

SkipBlanks_

:=False,Transpose:=False

EndSub

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

WithApplication

.Calculation=xlManual.MaxChange=0.001EndWith

ActiveWorkbook.PrecisionAsDisplayed=FalseSelection=\"=TEXT(NOW(),\"\"yyyy-m-dh:mm:ss\"\")\"Selection.Copy

Selection.PasteSpecialPaste:=xlPasteValues,Operation:=xlNone,

SkipBlanks_

:=False,Transpose:=False

思颐集团电商事业部务实第42页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

Windows.ArrangeArrangeStyle:=xlCascadeApplication.CutCopyMode=False

WithApplication

.Calculation=xlAutomatic.MaxChange=0.001EndWith

ActiveWorkbook.PrecisionAsDisplayed=FalseEndSub

25.不连续区域录入对勾Sub批量录入对勾()Selection.FormulaR1C1=\"√\"EndSub

26.不连续区域录入当前文件名Sub批量录入当前文件名()

Selection.FormulaR1C1=ThisWorkbook.NameEndSub

思颐集团电商事业部务实第43页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

27.不连续区域添加文本Sub批量添加文本()DimsAsRangeForEachsInSelections=s&\"文本内容\"NextEndSub

28.不连续区域插入文本Sub批量插入文本()DimsAsRangeForEachsInSelections=\"文本内容\"&sNextEndSub

29.从指定位置向下同时录入多单元指定内容Sub从指定位置向下同时录入多单元指定内容()Dimarr

思颐集团电商事业部务实第44页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

arr=Array(\"1\\"2\\"13\\"25\\"46\\"12\\"0\\"20\")

[B2].Resize(8,1)=Application.WorksheetFunction.Transpose(arr)EndSub

30.按aa工作表A列的内容排列工作表标签顺序Sub按aa工作表A列的内容排列工作表标签顺序()

DimI%,str1$

I=1

Sheets(\"aa\").Select

DoWhileCells(I,1).Value<>\"\"

str1=Trim(Cells(I,1).Value)Sheets(str1).Select

Sheets(str1).Moveafter:=Sheets(I)I=I+1

Sheets(\"aa\").Select

LoopEndSub

思颐集团电商事业部务实第45页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

31.删除全部未选定工作表Sub删除全部未选定工作表()

DimshtAsWorksheet,nAsInteger,iFlagAsBooleanDimShtName()AsString

n=ActiveWindow.SelectedSheets.CountReDimShtName(1Ton)n=1

ForEachshtInActiveWindow.SelectedSheets

ShtName(n)=sht.Namen=n+1Next

Application.DisplayAlerts=FalseForEachshtInSheets

iFlag=FalseFori=1Ton-1

IfShtName(i)=sht.NameThen

iFlag=TrueExitForEndIfNext

IfNotiFlagThensht.Delete

思颐集团电商事业部务实第46页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

Next

Application.DisplayAlerts=TrueEndSub

32.工作表标签排序Sub工作表标签排序()

DimiAsLong,jAsLong,numsAsLong,msgAsLong

msg=MsgBox(\"工作表按升序排列请选'是[Y]'.\"&vbCrLf&vbCrLf&\"工作表按降序排列请选'否[N]'\vbYesNoCancel,\"工作表排序\")

Ifmsg=vbCancelThenExitSub

nums=Sheets.Count

Ifmsg=vbYesThen'Sortascending

Fori=1Tonums

Forj=iTonums

IfUCase(Sheets(j).Name)Sheets(j).MoveBefore:=Sheets(i)EndIf

思颐集团电商事业部务实第47页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

NextjNexti

Else'SortdescendingFori=1Tonums

Forj=iTonums

IfUCase(Sheets(j).Name)>UCase(Sheets(i).Name)Then

Sheets(j).MoveBefore:=Sheets(i)EndIfNextjNextiEndIfEndSub

33.在目录表建立本工作簿中各表链接目录Sub在目录表建立本工作簿中各表链接目录()Dims%,RngAsRange

OnErrorResumeNextSheets(\"目录\").ActivateIfErr=0Then

Sheets(\"目录\").UsedRange.DeleteElse

思颐集团电商事业部务实第48页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

Sheets.Add

ActiveSheet.Name=\"目录\"EndIf

Fori=1ToSheets.Count

IfSheets(i).Name<>\"目录\"Then

s=s+1

SetRng=Sheets(\"目录\").Cells(((s-1)Mod20)+1,(s-1)\\20+

1+1)

Rng=Format(s,\"0\")&\".\"&Sheets(i).Name

ActiveSheet.Hyperlinks.AddRng,\"#\"&Sheets(i).Name&\"!A1\

ScreenTip:=Sheets(i).Name

EndIfNext

Sheets(\"目录\").Range(\"b:iv\").EntireColumn.ColumnWidth=20EndSub

34.建立工作表文本目录Sub建立工作表文本目录()Sheets.Addbefore:=Sheets(1)

思颐集团电商事业部务实第49页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

Sheets(1).Name=\"目录\"Fori=2ToSheets.CountCells(i-1,1)=Sheets(i).Name

'Sheets(1).Hyperlinks.AddCells(i-1,1),\"#\"&Sheets(i).Name&\"!A1\"加超链接

'添

NextEndSub

35.查另一文件的全部表名Sub查另一文件的全部表名()OnErrorResumeNextDimi%

DimshAsWorksheet

Application.ScreenUpdating=False

Workbooks.OpenFilename:=ThisWorkbook.Path&\"\\2.xls\"

Windows(\"1.xls\").Activate'当前文件名称Sheets(\"Sheet1\").Selecti=1

'当前表名称

'将表名称返回到第1行

思颐集团电商事业部务实第50页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

ForEachshInWorkbooks(\"2.xls\").WorksheetsCells(i,1)=sh.Namei=i+1Nextsh

Windows(\"2.xls\").Close

'关闭对象文件'将表名称返回到第1列'返回每个表名称向下移动1行

Application.ScreenUpdating=TrueEndSub

36.当前单元录入计算机名Sub当前单元录入计算机名()

Selection=Environ(\"COMPUTERNAME\")

'Selection=Workbooks(\"临时表\").Sheets(\"表2\").Range(\"A1\")调用指定地址内容

EndSub

37.当前单元录入计算机用户名Sub当前单元录入计算机用户名()Selection=Environ(\"Username\")

'Selection=Workbooks(\"临时表\").Sheets(\"表2\").Range(\"A1\")调用指定地

址内容

思颐集团电商事业部务实第51页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

EndSub

38.为指定工作表加指定密码保护表Sub为指定工作表加指定密码保护表()Sheet10.ProtectPassword:=\"123\"EndSub

39.在有密码的工作表执行代码Sub在有密码的工作表执行代码()

Sheets(\"1\").UnprotectPassword:=123'假定表名为“1”，密码为“123”打开工作表

Range(\"C:C\").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden=True藏C列空值行

Sheets(\"1\").ProtectPassword:=123EndSub

'重新用密码保护工作表

'隐

40.拷贝A1公式和格式到A2Sub拷贝A1公式到A2()

Workbooks(\"临时表\").Sheets(\"表1\").Range(\"A1\").Copy

思颐集团电商事业部务实第52页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

Workbooks(\"临时表\").Sheets(\"表2\").Range(\"A2\").PasteSpecialEndSub

41.复制单元数值Sub复制数值()

s=Workbooks(\"book1\").Sheets(\"Sheet1\").Range(\"A1:A2\")Workbooks(\"book2\").Sheets(\"Sheet1\").Range(\"A1:A2\")=sEndSub

42.插入数值条件格式Sub插入数值条件格式()

Selection.FormatConditions.Delete

Selection.FormatConditions.AddType:=xlCellValue,Operator:=xlGreater,_

Formula1:=\"70\"

Selection.FormatConditions(1).Interior.ColorIndex=45

Selection.FormatConditions.AddType:=xlCellValue,Operator:=xlLess,_

Formula1:=\"55\"

Selection.FormatConditions(2).Interior.ColorIndex=39

Selection.FormatConditions.AddType:=xlCellValue,Operator:=xlGreater,_

思颐集团电商事业部务实第53页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

Formula1:=\"60\"

Selection.FormatConditions(3).Interior.ColorIndex=34EndSub

43.插入透明批注Sub插入透明批注()

Selection.AddComment

Selection.Comment.Visible=False

DimXSAsWorksheet

Fori=1ToActiveSheet.Comments.Count

ActiveSheet.Comments(i).Text\"透明批注\"

ActiveSheet.Comments(i).Shape.Fill.Visible=msoFalseNextEndSub

44.添加文本Sub添加文本()

Selection=Selection+\"×\"

'不可在数字后添加文本

思颐集团电商事业部务实第54页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

'Selection=Workbooks(\"临时表\").Sheets(\"表2\").Range(\"A1\")调用指定地址内容

EndSub

45.光标定位到指定工作表A列最后数据行下一单元Sub光标定位到指定工作表A列最后数据行下一单元()a=Sheets(\"数据库\").[a65536].End(xlUp).Row

Sheets(\"数据库\").SelectRange(\"A\"&a+1).SelectEndSub

46.定位选定单元格式相同的全部单元格Sub定位选定单元格式相同的全部单元格()

DimFirstCellAsRange,FoundCellAsRangeDimAllCellsAsRange

WithApplication.FindFormat

.Clear

.NumberFormatLocal=Selection.NumberFormatLocal.HorizontalAlignment=Selection.HorizontalAlignment.VerticalAlignment=Selection.VerticalAlignment

思颐集团电商事业部务实第55页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

.WrapText=Selection.WrapText.Orientation=Selection.Orientation.AddIndent=Selection.AddIndent.IndentLevel=Selection.IndentLevel.ShrinkToFit=Selection.ShrinkToFit.MergeCells=Selection.MergeCells.Font.Name=Selection.Font.Name.Font.FontStyle=Selection.Font.FontStyle.Font.Size=Selection.Font.Size

.Font.Strikethrough=Selection.Font.Strikethrough.Font.Subscript=Selection.Font.Subscript.Font.Underline=Selection.Font.Underline.Font.ColorIndex=Selection.Font.ColorIndex.Interior.ColorIndex=Selection.Interior.ColorIndex.Interior.Pattern=Selection.Interior.Pattern.Locked=Selection.Locked

.FormulaHidden=Selection.FormulaHiddenEndWith

SetFirstCell=ActiveSheet.UsedRange.Find(what:=\"\searchformat:=True)

IfFirstCellIsNothingThenExitSub

思颐集团电商事业部务实第56页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

EndIf

SetAllCells=FirstCellSetFoundCell=FirstCell

Do

SetFoundCell=ActiveSheet.UsedRange.Find(After:=FoundCell,

what:=\"\searchformat:=True)

IfFoundCellIsNothingThenExitDoSetAllCells=Union(FoundCell,AllCells)

IfFoundCell.Address=FirstCell.AddressThenExitDoLoop

AllCells.SelectEndSub

47.按当前单元文本定位Sub按当前单元文本定位()

ABC=Selection

DimaaAsRange

ForEachaInActiveSheet.UsedRange

思颐集团电商事业部务实第57页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

IfaLikeABCThenIfaaIsNothingThenSetaa=a.CellsElse

Setaa=Union(aa,a.Cells)EndIfEndIfNextaa.SelectEndSub

48.按固定文本定位Sub文本定位()DimaaAsRange

ForEachaInActiveSheet.UsedRangeIfaLike\"*合计*\"ThenIfaaIsNothingThenSetaa=a.CellsElse

Setaa=Union(aa,a.Cells)EndIf

思颐集团电商事业部务实第58页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

EndIfNextaa.SelectEndSub

49.删除包含固定文本单元的行或列Sub删除包含固定文本单元的行或列()Do

Cells.Find(what:=\"哈哈\").ActivateSelection.EntireRow.Delete

'删除行

'Selection.EntireColumn.Delete'删除列LoopUntilCells.Find(what:=\"哈哈\")IsNothingEndSub

50.定位数据及区域以上的空值Sub定位数据及区域以上的空值()DimaaAsRange

ForEachaInActiveSheet.UsedRangeIfaLike〈0ThenIfaaIsNothingThen

思颐集团电商事业部务实第59页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

Setaa=a.CellsElse

Setaa=Union(aa,a.Cells)EndIfEndIfNextaa.SelectEndSub

51.右侧单元自动加5(工作表代码)PrivateSubWorksheet_Change(ByValTargetAsRange)Application.EnableEvents=FalseTarget.Offset(0,1)=Target+5Application.EnableEvents=TrueEndSub

52.当前单元加2Sub当前单元加2()Selection=Selection+2

'Selection=Workbooks(\"临时表\").Sheets(\"表2\").Range(\"A1\")调用指定地

思颐集团电商事业部务实第60页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

址内容

EndSub

53.A列等于A列减B列SubA列等于A列减B列()Fori=1To23

Cells(i,1)=Cells(i,1)-Cells(i,2)NextEndSub

54.用于光标选定多区域跳转指定单元(工作表代码)PrivateSubWorksheet_SelectionChange(ByValTAsRange)a=Array([b6:b7],[e6],[h6])Fori=0To2

IfNotApplication.Intersect(T,a(i))IsNothingThen[a1].Select:ExitForEndIfNextEndSub

思颐集团电商事业部务实第61页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

55.将A1单元录入的数据累加到B1单元（工作表代码）PrivateSubWorksheet_Change(ByValTargetAsRange)DimtAsLong

IfTarget.Address=\"$A$1\"Thent=Sheet1.Range(\"$B$1\").Value

Sheet1.Range(\"$B$1\").Value=t+Target.ValueEndIfEndSub

56.在指定颜色区域选择单元时添加/取消\"√\"（工作表代码）PrivateSubWorksheet_SelectionChange(ByValTargetAsRange)

DimmyrgAsRangeForEachmyrgInTarget

Ifmyrg.Interior.ColorIndex=37Thenmyrg=IIf(myrg<>\"√\\"√\

\"\")

NextEndSub

思颐集团电商事业部务实第62页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

57.在指定区域选择单元时添加/取消\"√\"（工作表代码）PrivateSubWorksheet_SelectionChange(ByValTargetAsRange)

DimRngAsRangeIfTarget.Count<=15Then

IfNotApplication.Intersect(Target,Range(\"D6:D20\"))IsNothingThen

ForEachRngInSelection

WithRng

If.Value=\"\"Then

.Value=\"√\"Else

.Value=\"\"EndIfEndWithNextEndIfEndIfEndSub

58.双击指定单元，循环录入文本（工作表代码）PrivateSubWorksheet_BeforeDoubleClick(ByValTAsRange,CancelAs

思颐集团电商事业部务实第63页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

Boolean)

IfT.Address<>\"$A$1\"ThenExitSubCancel=True

T=IIf(T=\"好\\"中\IIf(T=\"中\\"差\\"好\"))EndSub

双击指定单元，循环录入文本（工作表代码）DimnumsAsByte

PrivateSubWorksheet_BeforeDoubleClick(ByValTargetAsRange,CancelAsBoolean)

IfTarget.Address=\"$A$1\"Thennums=numsMod3+1Target=Mid(\"上中下\nums,1)Target.Offset(1,0).SelectEndIfEndSub

59.单元区域引用（工作表代码）PrivateSubWorksheet_Activate()

Sheet1.Range(\"A1:B3\").Value=Sheet2.Range(\"A1:B3\").ValueEndSub

思颐集团电商事业部务实第页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

60.在指定区域选择单元时数值加1（工作表代码）PrivateSubWorksheet_SelectionChange(ByValTargetAsRange)

IfNotApplication.Intersect([a1:e10],Target)IsNothingThen

Target=Val(Target)+1EndIfEndSub

61.选择单元区域触发事件（工作表代码）PrivateSubWorksheet_SelectionChange(ByValTargetAsRange)IfTarget.Address=\"$A$1:$B$2\"ThenMsgBox\"你选择了$A$1:$B$2单元\"EndIfEndSub

62.当修改指定单元内容时自动执行宏（工作表代码）PrivateSubWorksheet_Change(ByValTargetAsRange)IfNotApplication.Intersect(Target,[B3:B4])IsNothingThen重排窗口

思颐集团电商事业部务实第65页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

EndIfEndSub

63.双击单元隐藏该行（工作表代码）PrivateSubWorksheet_BeforeDoubleClick(ByValTargetAsRange,CancelAsBoolean)

Rows(Target.Row).Hidden=TrueEndSub

.高亮显示行（工作表代码）PrivateSubWorksheet_SelectionChange(ByValTargetAsRange)Cells.Interior.ColorIndex=2Rows(\"1:2\").Interior.ColorIndex=40

'保持1至2行的颜色推荐39,22,40,

'高亮推荐颜色

Rows(Target.Row).Interior.ColorIndex=3535,20,24,34,37,40,15EndSub

65.为指定工作表设置滚动范围（工作簿代码）PrivateSubWorkbook_SheetSelectionChange(ByValShAsObject,ByValTarget

思颐集团电商事业部务实第66页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

AsRange)

Sheet1.ScrollArea=\"A1:M30\"EndSub

66.将全部工作表的A1单元作为单击按钮（工作簿代码）PrivateSubWorkbook_SheetSelectionChange(ByValShAsObject,ByValTargetAsRange)

IfTarget.Address=\"$A$1\"Then

Call宏名EndIfEndSub

67.闹钟——到指定时间执行宏（工作簿代码）PrivateSubWorkbook_Open()

Application.OnTime(\"11:45:00\"),\"提示1\"Application.OnTime(\"12:00:00\"),\"提示2\"EndSub

思颐集团电商事业部务实第67页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

68.改变Excel界面标题的宏（工作簿代码）PrivateSubWorkbook_Open()Application.Caption=\"春节快乐\"EndSub

69.在指定工作表的指定单元返回光标当前多选区地址（工作簿代码）PrivateSubWorkbook_SheetSelectionChange(ByValShAsObject,ByValTargetAsRange)

Worksheets(\"表2\").Range(\"A1\")=Target.Address(0,0)EndSub

70.B列录入数据时在A列返回记录时间（工作表代码）PublicSubWorksheet_Change(ByValTargetAsRange)IfTarget.Column=2ThenTarget.Offset(,-1)=NowEndIfEndSub

思颐集团电商事业部务实第68页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

71.每编辑一个单元保存文件PrivateSubWorksheet_Change(ByValTargetAsRange)ThisWorkbook.SaveEndSub

72.指定允许编辑区域Sub指定允许编辑区域()ActiveSheet.ScrollArea=\"B8:G15\"EndSub

73.解除允许编辑区域Sub解除允许编辑区域()ActiveSheet.ScrollArea=\"\"EndSub

74.删除A列为指定内容的行Sub删除A列为指定内容的行()Dima,bAsInteger

a=Sheet1.[a65536].End(xlUp).Row

思颐集团电商事业部务实第69页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

Forb=aTo2Step-1

IfCells(b,1).Value=\"删除\"ThenRows(b).DeleteEndIfNextEndSub

75.删除A列非数字单元行Sub删除A列非数字单元行()i=[a65536].End(xlUp).Row

Range(\"A1:A\"&i).SpecialCells(xlCellTypeConstants,2).EntireRow.DeleteEndSub

76.有条件删除当前行Sub有条件删除当前行()If[A1]=2Or[B1]=\"删除\"ThenSelection.DeleteShift:=xlUpEndIfEndSub

思颐集团电商事业部务实第70页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

77.选择下一行Sub选择下一行()

ActiveCell.Offset(1,0).Rows(\"1:1\").EntireRow.SelectEndSub

78.选择光标或选区所在行Sub选择光标或选区所在行()

Selection.EntireRow.SelectEndSub

79.选择光标或选区所在列Sub选择光标或选区所在列()

Selection.EntireColumn.SelectEndSub

80.光标定位到名称指定位置Sub定位()

Application.GotoRange(Evaluate(\"名称\"))

思颐集团电商事业部务实第71页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

EndSub

81.选择名称定义的数据区Sub选择名称定义的数据区()

[数据区].Select'插入名称要使用INDIRECT函数'Range(\"数据区\").Select

或者

'Sheet1.Range(\"数据区\").Select或者EndSub

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

Sheet1.Columns(\"A:A\").SpecialCells(2,23).SpecialCells(12).Copy

Sheet2.[A1]EndSub

83.将名称1的数据写到名称2SubMacro2()

Range(\"位置2\")=Range(\"位置1\").ValueEndSub

思颐集团电商事业部务实第72页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

84.单元反选Sub单元反选()

Application.DisplayAlerts=FalseApplication.ScreenUpdating=FalseDimraddressAsString,taddressAsStringraddress=Selection.Address

taddress=ActiveSheet.UsedRange.AddressWithSheets.Add.Range(taddress)=0.Range(raddress)=\"=0\"

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

ActiveSheet.Range(raddress).SelectApplication.ScreenUpdating=TrueEndSub

85.调整选中对象中的文字Sub调整选中对象中的文字()

思颐集团电商事业部务实第73页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

'文字居中、自动调整大小

WithSelection

.HorizontalAlignment=xlCenter.VerticalAlignment=xlCenter.ReadingOrder=xlContext.Orientation=xlHorizontal.AutoSize=True.AddIndent=FalseEndWithEndSub

86.去除指定范围内的对象Sub去除指定范围内的对象()DimpAsShape

SetMy=Worksheets(\"工作表名\")ForEachpInMy.Shapes

IfNotApplication.Intersect(p.TopLeftCell,Range(\"范围\"))IsNothing

Thenp.Delete

NextEndSub

思颐集团电商事业部务实第74页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

87.更新透视表数据项SubDeleteMissingItems2002All()'防止数据透视表中显示无用的数据项'在Excel2002或更高版本中'如果无用的数据项已经存在,'运行这个宏可以更新DimptAsPivotTableDimwsAsWorksheet

ForEachwsInActiveWorkbook.WorksheetsForEachptInws.PivotTables

pt.PivotCache.MissingItemsLimit=xlMissingItemsNoneNextptNextwsEndSub

88.将全部工作表名称写到A列Sub将全部表名称写到A列()k=1

ForEachShtInSheetsCells(k+1,1)=Sht.Name

'指定写入的行和列

思颐集团电商事业部务实第75页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

k=k+1NextEndSub

.为当前选定的多单元插入指定名称Sub为当前选定的多单元插入指定名称()Selection.Name=\"临时\"

ActiveWorkbook.Names.AddName:=\"临时\RefersTo:=Selection这行代码也可以EndSub

'或者换用

90.以指定区域为表目录补充新表Sub以指定区域为表目录补充新表()DimdicAsObject,shAsWorksheetDimarr,item

arr=Range(\"B1:BB1\")

Setdic=CreateObject(\"scripting.dictionary\")ForEachshInThisWorkbook.Worksheets

dic.Addsh.Name,\"\"Next

思颐集团电商事业部务实第76页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

ForEachitemInarr

Ifitem<>\"\"AndNotdic.exists(Trim(item))Then

WithThisWorkbook.Worksheets.Add

.Name=itemEndWithEndIfNextSetdic=NothingEndSub

91.按A列数据批量修改表名称Sub按A列数据批量修改表名称()

Dimi%

Fori=1ToSheets.Count-1

Sheets(i).Name=Cells(i+1,1).TextNextEndSub

92.清除剪贴板Sub清除剪贴板()

思颐集团电商事业部务实第77页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

Application.CutCopyMode=False

Application.CommandBars(\"TaskPane\").Visible=FalseEndSub

93.批量清除软回车Sub批量清除软回车()

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

Cells.ReplaceWhat:=Chr(10),Replacement:=\"\LookAt:=xlPart,

SearchOrder:=_

xlByRows,MatchCase:=False,SearchFormat:=False,

ReplaceFormat:=FalseEndSub

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

ActiveWorkbook.SaveAsFilename:=\"E:\\信件\\\"&ActiveWorkbook.NameEndSub

思颐集团电商事业部务实第78页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

95.另存指定文件名Sub另存指定文件名()

ActiveWorkbook.SaveAsThisWorkbook.Path&\"\\别名.xls\"EndSub

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

ActiveWorkbook.SaveAsFilename:=ThisWorkbook.Path&\"\\\"&ActiveSheet.Name&\".xls\"EndSub

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

ActiveWorkbook.SaveAsFilename:=ActiveSheet.Name&\".xls\"EndSub

98.以活动工作表名称另存文件到Excel当前默认目录Sub以活动工作表名称另存文件到Excel当前默认目录()

思颐集团电商事业部务实第79页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

ActiveWorkbook.SaveAsFilename:=ActiveSheet.Name&\".xls\

FileFormat:=_

xlNormal,Password:=\"\WriteResPassword:=\"\

ReadOnlyRecommended:=False_

,CreateBackup:=False

EndSub

99.另存所有工作表为工作簿Sub另存所有工作表为工作簿()DimshtAsWorksheet

Application.ScreenUpdating=Falseipath=ThisWorkbook.Path&\"\\\"ForEachshtInSheets

sht.Copy

ActiveWorkbook.SaveAsipath&sht.Name&\".xls\"'(工作表名称为文件

名）

'ActiveWorkbook.SaveAsipath&sht.Name&Trim(sht.[d15])&\".xls\"'（文件名称&D15单元内容）

'ActiveWorkbook.SaveAsipath&Trim(sht.[d15])&\".xls\"D15单元内容）

ActiveWorkbook.Close

'（文件名称为

思颐集团电商事业部务实第80页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

Next

Application.ScreenUpdating=TrueEndSub

100.以指定单元内容为新文件名另存文件Sub以指定单元内容为新文件名另存文件()

ThisWorkbook.SaveAsFilename:=ThisWorkbook.Path&\"\\\"&Sheet1.[A1]EndSub

101.以当前日期为新文件名另存文件Sub以当前日期为新文件名另存文件()

ThisWorkbook.SaveAsThisWorkbook.Path&\"\\\"&Format(Now(),\"yyyymmdd\")&\".xls\"EndSub

Sub以当前日期为名称另存文件()

ActiveWorkbook.SaveAsFilename:=Date&\".xls\"EndSub

思颐集团电商事业部务实第81页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

102.以当前日期和时间为新文件名另存文件Sub以当前日期和时间为新文件名另存文件()

ThisWorkbook.SaveAsThisWorkbook.Path&\"\\\"&Format(Now(),\"yyyy\"&\"年\"&\"mm\"&\"月\"&\"dd\"&\"日\"&\"h\"&\"时\"&\"mm\"&\"分\"&\"ss\"&\"秒\")&\".xls\"EndSub

103.另存本表为TXT文件Sub另存本表为TXT文件()

DimsAsString

DimFullNameAsString,rngAsRangeApplication.ScreenUpdating=FalseFullName=(ActiveSheet.Name&\".txt\")'

'以当前表名为TXT文件名

FullName=Replace(ThisWorkbook.FullName,\".xls\\".txt\")'以当前文

件名为TXT文件名

'

FullName=Replace(ThisWorkbook.FullName,\".xls\ActiveSheet.Name&

\".txt\")'以文件名&表名为TXT文件名

OpenFullNameForOutputAs#1

都会覆盖原先的内容

'参考帮助，fullname为文件全名

'以读写方式打开文件，每次写内容

思颐集团电商事业部务实第82页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

ForEachrngInRange(\"a1\").CurrentRegion

s=s&IIf(s=\"\\"\\"|\")&rng.Value

Ifrng.Column=Range(\"a1\").CurrentRegion.Columns.CountThen

Print#1,s&\"|\"s=\"\"EndIfNextClose#1

'关闭文件

'把数据写到文本文件里

Application.ScreenUpdating=TrueMsgBox\"数据已导入文本\"EndSub

104.引用指定位置单元内容为部分文件名另存文件Sub引用指定位置单元内容为部分文件名另存文件()

ActiveWorkbook.SaveAsFilename:=\"E:\\信件\\\"&\"解答\"&Range(\"sheet1!a1\")&\"郎雀.xls\"EndSub

105.将A列数据排序到D列Sub将A列数据排序到D列()

思颐集团电商事业部务实第83页共129页

团结合作荣誉效率态度2016-3-31

思颐浩工总制作社内培中心EXCEL篇

[d:d]=[a:a].Value

[d:d].SortKey1:=Range(\"D1\"),Order1:=xlAscending,Header:=xlYesEndSub

106.将指定范围的数据排列到D列Sub将指定范围的数据排列到D列()Dimarr1,arr2,i%,xarr1=Range(\"A1:C3\")

ReDimarr2(1ToUBound(arr1,1)*UBound(arr1,2),1To1)ForEachxInApplication.Transpose(arr1)i=i+1arr2(i,1)=xNextx

Range(\"D1\").Resize(i,1)=arr2EndSub

107.光标移动Sub光标移动()

ActiveCell.Offset(1,2).SelectEndSub

'向下移动1行，向右移动2列

思颐集团电商事业部务实第84页共129页

团结合作荣誉效率态度2016-3-31