Execl宏程序总结讲解.docx
- 文档编号:25660359
- 上传时间:2023-06-11
- 格式:DOCX
- 页数:20
- 大小:18.57KB
Execl宏程序总结讲解.docx
《Execl宏程序总结讲解.docx》由会员分享,可在线阅读,更多相关《Execl宏程序总结讲解.docx(20页珍藏版)》请在冰豆网上搜索。
Execl宏程序总结讲解
宏
SubMacro1()
'
'Macro1Macro
'宏由lenovo录制,时间:
2012/9/19
'
'快捷键:
Ctrl+z
'
k=1'循环变量
DoWhilek<=Worksheets.Count'工作表数量
Sheets(k).Select'逐个设置工作为当前工作表
Rem====确定真正的最后一行
Rem====先用定位的方法找到工作表中的最后一个单元格Selection.SpecialCells(xlCellTypeLastCell).Select
flag=False
Rem====向上循环判断是否是空行
DoWhileflag=False
Rem====如果是第一行,退出循环,否则后面的Offset语句向上移动时会出错IfActiveCell.Row=1Then
ExitDo
EndIf
Rem====判断当前行是不是空行
Selection.End(xlToLeft).Select
temp1=IsEmpty(ActiveCell.Value)
Selection.End(xlToRight).Select
temp2=IsEmpty(ActiveCell.Value)
Iftemp1=TrueAndtemp2=TrueThen
Rem====如果是空行则选择上一行
Selection.Offset(-1,0).Select
Else
Rem====如果不是空行,说明已经是真正的最后一行,退出循环flag=True
ExitDo
EndIf
Loop
Rem====把最后一行的行号赋给一个变量
row_last=ActiveCell.Row
Cells(row_last,1).Select
k=k+1
Loop
EndSub
SubMacro1()
'Macro1Macro
'宏由lenovo录制,时间:
2012/9/19
'
'快捷键:
Ctrl+z
'
k=1'循环变量
DoWhilek<=Worksheets.Count'工作表数量
Sheets(k).Select'逐个设置工作为当前工作表
endrow=Range("B65536").End(xlUp).Row
Fori=endrowTo6Step-1
IfCells(i,3)=""AndCells(i,5)=""ThenCells(i,2)=""Next
k=k+1
Loop
EndSubSubMacro6()
'
'Macro6Macro
'宏由lenovo录制,时间:
2012/9/24
'
'快捷键:
Ctrl+x
'
k=1'循环变量
MsgBoxWorksheets.Count
DoWhilek<=Worksheets.Count'工作表数量
Sheets(k).Select'逐个设置工作为当前工作表
Range("C3:
J3").Select
Selection.Borders(xlDiagonalDown).LineStyle=xlNoneSelection.Borders(xlDiagonalUp).LineStyle=xlNoneSelection.Borders(xlEdgeLeft).LineStyle=xlNoneSelection.Borders(xlEdgeTop).LineStyle=xlNoneSelection.Borders(xlEdgeBottom).LineStyle=xlNoneSelection.Borders(xlEdgeRight).LineStyle=xlNoneSelection.Borders(xlInsideVertical).LineStyle=xlNoneSelection.Borders(xlInsideHorizontal).LineStyle=xlNoneRange("A6:
K37").Select
WithSelection.Font
.Size=9
.Strikethrough=False
.Superscript=False
.Subscript=False
.OutlineFont=False
.Shadow=False
.Underline=xlUnderlineStyleNone
.ColorIndex=1
EndWith
Range("A6:
M37").Select
Selection.Borders(xlDiagonalDown).LineStyle=xlNoneSelection.Borders(xlDiagonalUp).LineStyle=xlNoneWithSelection.Borders(xlEdgeLeft)
.LineStyle=xlContinuous
.Weight=xlThin
.ColorIndex=xlAutomatic
EndWith
WithSelection.Borders(xlEdgeTop)
.LineStyle=xlContinuous
.Weight=xlThin
.ColorIndex=xlAutomatic
EndWith
WithSelection.Borders(xlEdgeBottom)
.LineStyle=xlContinuous
.Weight=xlThin
.ColorIndex=xlAutomatic
EndWith
WithSelection.Borders(xlEdgeRight)
.LineStyle=xlContinuous
.Weight=xlThin
.ColorIndex=xlAutomaticEndWith
WithSelection.Borders(xlInsideVertical).LineStyle=xlContinuous.Weight=xlThin
.ColorIndex=xlAutomaticEndWith
WithSelection.Borders(xlInsideHorizontal).LineStyle=xlContinuous.Weight=xlThin
.ColorIndex=xlAutomaticEndWith
Columns("A:
A").ColumnWidth=3Columns("B:
B").ColumnWidth=6.63Columns("E:
E").ColumnWidth=5.88Columns("F:
F").ColumnWidth=6Columns("I:
I").ColumnWidth=7.5Columns("J:
J").ColumnWidth=7.75Columns("M:
M").ColumnWidth=7.13
Rows("1:
1").RowHeight=15
Rows("2:
2").RowHeight=44.25Rows("4:
4").RowHeight=24.75Rows("6:
6").RowHeight=63
Rows("6:
6").RowHeight=66
Fori=6To36
Rows(i&":
"&i).RowHeight=16.5Next
k=k+1
Loop
EndSubSubMacro3()
'
'Macro3Macro
'宏由lenovo录制,时间:
2012/9/23'
'快捷键:
Ctrl+z
'
k=1'循环变量
DoWhilek<=Worksheets.Count'工作表数量Sheets(k).Select'逐个设置工作为当前工作表
Fori=36To6Step-1
IfCells(i,8)<>""Then
Cells(i,5)=""
Cells(i,3)=""
Else
Cells(i,2)=""
Cells(i,5)=""
Cells(i,3)=""
EndIf
Next
k=k+1
Loop
EndSub
SubMacro6()
'
'Macro6Macro
'宏由lenovo录制,时间:
2012/9/19'
'快捷键:
Ctrl+z
'
k=1'循环变量
DoWhilek<=Worksheets.Count'工作表数量Sheets(k).Select'逐个设置工作为当前工作表IfCells(3,9)<>""Then
Sheets(k).Name=Cells(3,9)
Else
IfCells(3,9)<>""Then
Sheets(k).Name=Cells(3,10)
Else
ExitSub
EndIf
EndIf
k=k+1
Loop
EndSub
SubMacro1()
'
'Macro1Macro
'宏由lenovo录制,时间:
2012/9/20'
'快捷键:
Ctrl+z
'
k=1'循环变量
DoWhilek<=Worksheets.Count'工作表数量Sheets(k).Select'逐个设置工作为当前工作表
endrow=Range("C36").End(xlUp).Row
A=0
B=0
Ifendrow>8Then
Fori=16To6Step-1
IfA=0Then
IfCells(i,3)<>""ThenCells(i,3).Select
A=Selection.ValueEndIf
Else
IfCells(i,3)<>""ThenCells(i,3).Select
B=Selection.ValueEndIf
IfB>AThen
ExitSub
EndIf
EndIf
Next
EndIf
k=k+1
Loop
EndSub
IfErr.Number<>0ThenErr.Clear
OnErrorResumeNext
setr=cells.find()
ifrisnothingthen
exitsub
else
你的代码
endif
插入一个模块粘贴以下代码SubSS()
DimMyFile,MyPathAsString
DimrngAsRange
istr=ThisWorkbook.Sheets("sheet1").Range("A1").Value
MyPath="C:
\"
arr=Split("456.xls,789.xls",",")
n=0
Do
OnErrorResumeNext
MyFile=arr(n)
Workbooks.Open(MyPath&"\"&MyFile)
Setrng=Workbooks(MyFile).Sheets("sheet1").UsedRange.Find(istr)IfNotrngIsNothingThen
ThisWorkbook.Sheets("sheet1").Rows
(2).Value=
Workbooks(MyFile).Sheets("sheet1").Rows(rng.Row).Value
Workbooks(MyFile).Close
ExitSub
EndIf
Workbooks(MyFile).Close
n=n+1
LoopWhilen<=1
MsgBox"Nothing"
EndSub
Range("A1").Select
ActiveCell.FormulaR1C1="6/1/2011"
Range("A1").Select
Selection.AutoFillDestination:
=Range("A1:
A30"),Type:
=xlFillDefault
Range("A1:
A30").Select
ActiveWindow.SmallScrollDown:
=-9
Selection.NumberFormatLocal="m/d;@"
WithSelection
.HorizontalAlignment=xlCenter
.VerticalAlignment=xlCenter
.WrapText=False
.Orientation=0
.AddIndent=False
.IndentLevel=0
.ShrinkToFit=False
.ReadingOrder=xlContext
.MergeCells=False
EndWith
属性的调整
Range("I5").Select
WithSelection.Font
.Name="宋体"
.Strikethrough=False
.Superscript=False
.Subscript=False
.OutlineFont=False
.Shadow=False
.Underline=xlUnderlineStyleNone
.ColorIndex=1
EndWith
J5格涮成H5
Range("J5").Select
Selection.Copy
Range("H5").Select
Selection.PasteSpecialPaste:
=xlPasteFormats,Operation:
=xlNone,_SkipBlanks:
=False,Transpose:
=False
Application.CutCopyMode=False
外框有没有
Selection.Borders(xlDiagonalDown).LineStyle=xlNone
Selection.Borders(xlDiagonalUp).LineStyle=xlNone
WithSelection.Borders(xlEdgeLeft)
.LineStyle=xlContinuous
.Weight=xlThin
.ColorIndex=xlAutomatic
EndWith
WithSelection.Borders(xlEdgeTop)
.LineStyle=xlContinuous
.Weight=xlThin
.ColorIndex=xlAutomatic
EndWith
WithSelection.Borders(xlEdgeBottom)
.LineStyle=xlContinuous
.Weight=xlThin
.ColorIndex=xlAutomatic
EndWith
WithSelection.Borders(xlEdgeRight)
.LineStyle=xlContinuous
.Weight=xlThin
.ColorIndex=xlAutomatic
EndWith
WithSelection.Borders(xlInsideVertical)
.LineStyle=xlContinuous
.Weight=xlThin
.ColorIndex=xlAutomatic
EndWith
WithSelection.Borders(xlInsideHorizontal)
.LineStyle=xlContinuous
.Weight=xlThin
.ColorIndex=xlAutomatic
EndWith
连续选择
Range("H5:
M5,2:
2").Select第二行
间隔选择
Range("F17,H17,H21,E23,E16,C16,C23").Select
运行宏程序
Application.Run"Book1.xls!
Macro1"
新建表格
Sheets.Add.Name="xinjian"
当前数据
Selection.Value
当前数据=ActiveCell
Row_Max=Worksheets
(1).UsedRange.Rows.最大行数
DimarAsRange
ForEacharInSelection.Areas选择的区域
ar.Value=ar.Value公式数值转换成数值
Nextar
ActiveWindow.SmallScrollDown:
=3鼠标滚动
Range("C6:
C36").Select
Selection.NumberFormatLocal="0.0_"一位有效数字
数组
DimxAsLong,yAsLong
Dimarr(1To10,1To3)'创建一个可以容下10行3列的数组空间
Forx=1To4
Fory=1To3
arr(x,y)=Cells(x,y)'通过循环把单元格区域a1:
c4的数据装进数组中Nexty
Nextx
MsgBoxarr(4,3)'根据提供的行数和列数显示数组
arr(1,2)="我改一下试试"'你可以随时修改数组内指定位置的数据
MsgBoxarr(1,2)
ARR=Application.Transpose(Range("a1:
a3"))‘用转置的方法,把单元格一列数据转换成一维数组
Subtest()
Dimx(1To11)AsSingle
Dimy(1To11)AsSingle
DimiAsInteger
n=1
Fori=-10To10Step2
x(n)=i
Cells(n,8)=x(n)
y(n)=x(n)^3+x(n)^2+x(n)
Cells(n,9)=y(n)
n=n+1
Next
EndSub
最小化
Application.WindowState=xlMinimized
取得焦点
Windows("4月自卸汽车IAI-062xls.xls").Activate
选中当前(活动)单元格左边第10个单元格。
ActiveCell.Offset(0,-10)range("A1").offset
(1)即向下偏移一行
Selection.offset(0,1)=Workbooks("Book1.xls").worksheets("sheet1").Range("A1")
选择第三个深水井,选择BVB903
Selection.AutoFilterField:
=3,Criteria1:
="BVB903"
给活动的单元格赋值
Range("A1").Select
ActiveCell.FormulaR1C1=<值>
得到指定单元格中的值
Range("<单元格地址>").Text
插入单元格
Selection.InsertShift:
=xlToRight‘在当前选中单元格的位置插入单元格并将当前选中的单元格向右移动
Selection.InsertShift:
=xlDown‘在当前选中单元格的位置插入单元格并将当前选中的单元格向下移动
Selection.EntireRow.Insert‘在当前选中单元格的上面插入一行
Selection.EntireColumn.Insert‘在当前选中单元格的左侧插入一列
设置字体名称和大小
Selection.Font.Name=<字体名称>
Selection.Font.Size=<字号>
Selection.Font.Bold=
Selection.Font.Italic=
Selection.Font.ColorIndex=<0到56之间的数字>
Selection.Font.Color=
清空选中单元格里的内容
Selection.ClearContents
删除选中的单元格
Selection.Delete
Selection.EntireRow.Delete
Selection.EntireColumn.Delete
得到当前EXCEL的文件名
ThisWorkbook.Path‘文件路径
ThisWorkbook.Name‘文件名
ThisWorkbook.FullName‘全路径
ActiveWorkbook.SaveAs(ThisWorkbook.Path&"\"&s&".xls")添加批注
Range("A1").AddComment("Writesthecontentinhere!
")
Range("B1").Comment.TextText:
="Writesthecontentinhere!
"修改批注显示/隐藏批注
Comment.Visible=
删除批注
ClearComments
Selection.Cut‘剪切
Selection.Copy‘复制
ActiveSheet.Paste‘粘贴
公式赋值
ActiveCell.Formula="=AVERAGE(R[-6]C[-4]:
R[-2]C[-4])"
Range("E10").Formula="=SUM(Sheet1!
R1C1:
R4C1)"
Worksheets("Sheet1").ActiveCell.Formula="=Max('1-1剖面'!
D3:
D5)"
DimfenshuAsInteger
fenshu=60
SelectCasefenshu‘给出条件分级别选择
Case90To100MsgBox"优异"Case75To89
MsgBox"优秀"
Case60To74
MsgBox"及格"
CaseElse
MsgBox"不及格"
EndSelect
---------------------------
Selection.AutoFilterField:
=3,Criteria1:
=">=0",Operator:
=xlAnd
Cells.Select
Selection.SpecialCells(xlCellTypeVisible).Select
(AutoFilter)自动筛选(Field:
=3)所
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- Execl 程序 总结 讲解