编程常用代码.docx
- 文档编号:9802100
- 上传时间:2023-02-06
- 格式:DOCX
- 页数:24
- 大小:25.53KB
编程常用代码.docx
《编程常用代码.docx》由会员分享,可在线阅读,更多相关《编程常用代码.docx(24页珍藏版)》请在冰豆网上搜索。
编程常用代码
编程常用代码
Excel2007启用宏:
OFFICE按钮→选项→信任中心→信任中心设置→宏设置
代码里可以命名名称,比如rng1.Name="data1",然后在公式中使用它
Debug.Print"7777"'在立即窗口中显示
Environ("Computername")'计算机名
Environ("userprofile") ‘桌面路径
ActiveWindow.Caption="XXXXX"'在显示文件名的地方显示XXXXX
Windows(ThisWorkbook.Name).Visible=False'隐藏excel主窗口ThisWorkbook.Name[文件名]
-------
文件和文件夹
当前文件夹的名称:
CurDir
更改文件或文件夹的名称:
(Name原文件As新文件)
检查文件或文件夹是否存在:
m=Dir(文件,Nomal)m=Dir(文件夹,Folder)Directory
创建文件夹(MkDir"D:
\文件夹名")
f=Dir("D:
\省份分表",vbDirectory)'判断是否已经存在
Iff=""ThenMkDir("D:
\省份分表")'如果不存在就建立
删除文件:
(Kill"D:
\文件夹名\成品.xls"
删除空文夹:
(RmDir"D:
\文件夹名")
---------
复制文件:
(FileCopy)
Fori=101To10000
FileCopy"D:
\迅雷.txt","D:
\文件夹名\"&i&"迅雷.txt"
Next
WithApplication.FileSearch
.Filename="*.*"
.LookIn=ThisWorkbook.Path&"\分表"
.Execute
k=.FoundFiles.Count'文件夹中的文件个数
EndWith
Sub生成目录()'有子文件夹也查到
Setfs=Application.FileSearch
Withfs
.LookIn="D:
\暂用\"'设置要查找的起始目录
.Filename="*.*"
.SearchSubFolders=True'是否查找子目录
.Execute'根据上面的设置执行查找
Fori=1To.FoundFiles.Count'遍历文件
a=Dir(.FoundFiles(i))
Cells(i+1,3)=a
Nexti
EndWith
EndSub
Shell"explorer.exe"&k&"\生成的表\",vbMaximizedFocus'展开文件夹
Sub动态读取指定文件夹名()
OnErrorResumeNext
DimstMeddAsString
stMedd="请选择文件目录:
"
SetobMapp=CreateObject("Shell.Application").BrowseForFolder(0,stMedd,&H1)
IfNotobMappIsNothingThen
Directory=obMapp.self.Path&"\"'文件夹名
[G1].Value=Directory
Else
ExitSub
EndIf
CallFilesList.FilesList
EndSub
变量
模块级变量的声明格式PublicDirectory
DimxAsInteger'声明变量
Byte(0到255的整数)Integer%(-32768+32768)Date(日期)String$(65400个字符)Decimal(小数)
Long&Single!
Currency@
Format(32,"0000")‘Format格式结果为:
0032
DimArr()
数组
ReDimPreserveArr(1Tor)‘声明动态数组
Array函数Application.Transpose‘转置
数组下限LBound(Arr)=0,数组上限UBound(Arr)=4
Erasearr’清空数组
IsArray’指出变量是否为一个数组
IfApplication.CountA(Arr)>0Then'判断数组不为空
Range("A1:
D1")=Array("'1001","现金",300000,Date)'在一行多列中依次输入不同数据
Range("A1:
A4")=Application.Transpose(Array("1001","现金",300000,Date))在一列多行中次输入不同数
Sub字典()
r=Sheet1.Range("A65536").End(xlUp).Row'最后行数
Setw=CreateObject("scripting.dictionary")
Fori=2Tor
b=Sheet1.Cells(i,2)
c=Sheet1.Cells(i,3)
IfNotw.exists(b&c)Then
w(b&c)=1
Else
W(b&c)=W(b&c)+1
EndIf
Next
[A2].Resize(w.Count,1)=Application.Transpose(w.keys)
[B2].Resize(w.Count,1)=Application.Transpose(w.items)
EndSub
Sub用字典筛选多列()
r=Range("A65536").End(xlUp).Row'最后行数
Setw=CreateObject("scripting.dictionary")
Fori=2Tor
IfCells(i,6)>70Then'语文分数为条件
w(Range(Cells(i,1),Cells(i,12)))=1'数据一行多列载入字典
EndIf
Nexti
[N2].Resize(w.Count,12)=Application.Transpose(Application.Transpose(w.keys))'两次转置写入单元格
EndSub
If"dfg"Like"*f*"Then判断字符串包含关系可用通配符
ForEachstInWorksheets
WithChr(10)ExitForstep步长ElseIfElseDoWhile…Loop
Application.ScreenUpdating=False'禁用刷新
Application.DisplayStatusBar=False'禁用状态显示
Application.Calculation=xlCalculationManual'手动重算
Application.EnableEvents=False'禁用触发事件
ActiveSheet.DisplayPageBreaks=False'禁用新版本
Application.ScreenUpdating=true'启用刷新
Application.DisplayStatusBar=true'显示状态
Application.EnableEvents=true'启用触发事件
Application.Calculation=xlAutomatic'自动重算
ActiveSheet.DisplayPageBreaks=true'启用新版本
Application.SheetsInNewWorkbook=1'设置工作簿内的工作表数
Application.SendKeys"%{down}"'自动打开数据有效性列表
Workbooks("学习.xls").Worksheets("Sheet1").Range("A4").ClearContents'从文件到单元格
Cells(4,1)Rang("A4")[A4]'单元格
Range("H3").Select'选定单元格
Range("A65536").End(xlUp)'最后行单元数据
x=Range("A65536").End(xlUp).Row'行数
x=Range("e2").End(xlDown).Row''向下查找
Range("IV1").End(xlToLeft)'最后列单元数据
Range("IV1").End(xlToLeft).Column'列数
UsedRange.Cells工作表使用区域的单元格
a=ActiveSheet.UsedRange.Item(ActiveSheet.UsedRange.Count).Row'格式最后行
b=ActiveSheet.UsedRange.Item(ActiveSheet.UsedRange.Count).Column'格式最后列
Cells(a,b)'最后一个单元格(不一定有数据)
(Cells(1,1),Cells(a,b))'数据最大区间起于A1单元格,止于最右下角单元格
f=Replace(mid(Cells(100,103).Address,2,2),"$","")'由列数得到列标CY
Cells.Find("*",,,,,2).Row'工作表使用的有数据行数
Cells.Find("*",,,,,2).Column'工作表使用的有数据列数
IsNumeric判断数值
Sheet1.UsedRange.Select'选定表1中使用的区域,如果要向下或右移在UsedRange.后加进offset(1,2)
Range("a1").CopyRange("B1")'将A1单元数值(公式)和格式值复制到sheet3B1中
注:
Range("a1")不能用Cells()替代
Range("B1").Value=Range("a1").Value'将A1单元数值复制到sheet3B1中
Range("C4:
E7").Clear'清除格式和内容
Range("D4:
E6").ClearContents'清除内容
ActiveWindow.VisibleRange.AddressLocal'返回屏幕上可以看到的区域
[a3].Value=Trim([a3].Value)'删除空格删左边Ltrim删右边RTrim
[a:
a].Replace"A",""'将A列的“A”替换成空单元格匹配LookAt:
=xlWhole
Application.SUBSTITUTE([A1],"","")‘清除空格
Range("B2").Offset(1,2).Select'以B2为基点,向下移1行,向右移2列
Selection.Resize(6,9).Select'得到一个6行9列的区域
Range("S1:
S28").TextToColumnsDataType:
=xlFixedWidth,FieldInfo:
=Array(Array(0,1),Array(2,1))
只分出第1、2个字符
Range("B3:
B"&k.Count+2).TextToColumns,Other:
=True,OtherChar:
="/"‘分列
[a:
b].AdvancedFilter2,[c1:
c2],[g1]'高级筛选最简代码数据区间[a:
b]条件[c1:
c2]存放位置[g1]
Sheet1.[a:
a].AdvancedFilter2,"",[b5],Unique:
=True'Unique:
=True(取不重复值)
[A1:
D11].AdvancedFilter2,,[E1],1'高级筛提取不重复值数据区间[A1:
D11]存放位置[E1]
MsgBox"行数为:
"&ActiveCell.Row&Chr(10)&"列数为:
"&ActiveCell.Column'当前行列数
Chr(10):
空行
公式
ClearContents-仅清除单元格或单元格区域内的数据
ClearFormats-仅清除格式
Range("A1").NumberFormat'读出A1格式
Range("A1").Formula'读出A1中的公式
Range("D2").FormulaArray="=SUM((A2:
A6)*1)"'先在D2中输入数组公式
Range("D2").CopyRange("D3:
D9,E2:
E9,F2:
F9")'复制、粘贴公式(区间连续或不连续,但不能包括D2)
Selection.Formula=Range("e2").Formula'将E2中的普通公式填充到当前区域
Form=2Toy'宏中动态引用公式(不适用于数组公式)
Range("m"&m)=Evaluate("SUMPRODUCT((sheet1!
A2:
A"&x&"=sheet2!
A"&m&")*(sheet1!
B2:
B"&x&"=sheet2!
B"&m&")*(sheet1!
L2:
L"&x&">sheet2!
L"&m&"))")+1
Find方法的语法
<单元格区域>.Find(要查找的数据,,[数据类型],[XlWhole或者xlPart,用来指定所查找的数据是与单元格内容完全匹配还是部分匹配,默认值为xlPart])
Sub由值查行列号()‘Find方法
Setr=Range("a1:
b12").Find([j6],,,XlWhole)‘对占用内存较多的对象变量,不要时要记住set=nothing
OnErrorResumeNext‘容错r=Empty(出错)
[K6]=r.Row'行号
[L6]=r.Column'列号
[m6]=r.Address'单元格
Setr=nothing‘置空对象
EndSub
Sub数组查找()
DimArr()
x=Sheet1.Range("A65536").End(xlUp).Row'行数
y=Range("A65536").End(xlUp).Row'行数
ReDimPreserveArr(1Toy)
Fori=1Toy
OnErrorResumeNext'容错
b=Cells(i,1)
Setr=Sheet1.Range("a1:
a"&x).Find(b,,,xlWhole)
Ifr=EmptyThen'Empty(出错)
Arr(i)=""
Else
Arr(i)=Sheet1.Cells(r.Row,2)
EndIf
Next
[B1].Resize(y,1)=Application.Transpose(Arr)
EndSub
MATCH函数方法用于取得关键字的行数或列数
IfIsNumeric(Application.Match(Cells(i,1),.Range("B1:
B"&r),0))Then
'关键字不存在时会出错,上句不可少
m=Application.Match(Cells(i,1),.Range("B1:
B"&r),0)'行数
Sub查找()
Application.ScreenUpdating=False'禁用刷新
WithSheets("资料表")
x=.Range("R65536").End(xlUp).Row
y=Range("F65536").End(xlUp).Row
Fori=2Toy
IfIsNumeric(Application.Match(Cells(i,6),.Range("R1:
R"&x),0))Then
m=Application.Match(Cells(i,6),.Range("R1:
R"&x),0)'行数
.Range("N"&m&":
Q"&m).CopyCells(i,1)
EndIf
Next
EndWith
EndSub
x=[a1]'多条件语句
Ifx<100Andx>80Then'第1句
[d5]="好"
ElseIfx=0Then'第2句
[d5]="最好"
Else'其他
[d5]="错误"
EndIf
SelectCaseSheets.Count'按条件选择执行宏
CaseIs>1
删除工作表
插入新表
CaseIs=1
插入新表
CaseElse
EndSelect
EndSub
ThisWorkbook.Path(或CurDir)'当前工作簿地址
ThisWorkbook.Name当前工作簿名称
ThisWorkbook.FullName'当前工作簿路径和名称
ActiveSheet.Name'当前工作表名
Sheet1.ScrollArea="B4:
H12"'限制表中显示的区间
PrivateSubWorkbook_Open()'打开工作簿时执行
ActiveWindow.CloseSavechanges:
=True'不保存关闭当前工作簿
PrivateSubWorkbook_BeforeClose(CancelAsBoolean)'关闭工作簿时执行
Application.Quit'不保存退出
Workbooks
(1).CloseSaveChanges:
=False‘不保存关闭指定工作簿
ActiveWorkbook.Save'保存退出
Workbooks.OpenFilename:
=ThisWorkbook.Path&"\档案.xls",Password:
="1234"
'如文件:
档案,有密码1234用这句代码可以打开excel模板文件类型:
xlt
ForEachcInApplication.Names'隐藏[显示]定义名
c.Visible=False
Nextc
MsgBox"宏"&Chr(13)&Chr(13)&"真难学啊!
",,"感叹"'消息框格式Chr(13)换行
InputBox函数:
格式如下,第一项为必须外,其余为可选项,可以省略不写,XY坐标为在窗体上的准确位置。
当用户点取消时,返回一个空的字符串("")。
为了省略某些位置参数,必须加入相应的逗号分界符。
InputBox("对话框中的提示信息","对话框的标题","缺省的返回值",X坐标,Y坐标)
X坐标和Y坐标当你需要为InputBox窗口指定在屏幕中的位置时用的,单位为象素,一般省略不写。
Val文本变数值
Sub选定单元格()‘InputBox方法Application.Interactive=True
DimaAsRange
OnErrorGoToVeryEnd'[当按下“取消”按钮时,程序会出错,加上此句与后边VeryEnd:
相对应,这样当出错时,程序结束或Application.Interactive=True]
Seta=Application.InputBox(prompt:
="使用鼠标选择单元格区域:
",Title:
="格式化区域",Type:
=8)
a.NumberFormat="0.00"'单元格式:
两位数
VeryEnd:
EndSub
Sub合并单元格()
Application.DisplayAlerts=False'合并时不提问
Forh=Range("A65536").End(xlUp).RowTo4Step-1
IfCells(h,10)=Cells(h+1,10)ThenRange(Cells(h,10),Cells(h+1,10)).Merge
Next
EndSub
Range("B4:
D5").Select'合并居中
WithSelection
.HorizontalAlignment=xlCenter
.VerticalAlignment=xlCenter
.ReadingOrder=xlContext
EndWith
Selection.Merge'(合并单元格)
――――
[a1:
g18].Borders.LineStyle=1'加细边框
Range("A6:
F10").Borders.LineStyle=xlContinuous'加细边框
Range("A6:
F10").BorderAroundWeight:
=xlThick'加边粗框
Range("A6:
F10").Borders.LineStyle=xlNone'去边框
――――
Sub循环()‘ExitFor跳出循环end
x=Range("A65536").End(xlUp).Row'声明最后一行的行号
Forh=5Tox'从第1行到最后一行step步长
IfCells(h,1)>0Then'判断、赋值
Cells(h,2)="大于零"
ElseIfCells(h,1)=0Then
Cells(h,2)="等于零"
ElseIfCells(h,1)<0Then
Cells(h,2)="小于零"
EndIf
Nexth
EndSub
Sub行列多循环()
a=[p2]-1
Forb=1To11Step2
Forc=4To28
a=a+1'此句决定其数据不同
Ifa>[p3]ThenExitSub'此句在达到最大值时退出循环
Cells(c,b)=a
Nextc,b
EndSub
PrivateSubWorksheet_Change(ByValTargetAsRange)'单元格触发事件[输入即保存]
IfTarget<>""Then'没有选定或输入字符不触发
ActiveWorkbook.Save'保存
EndIf
EndSub
PrivateSubWorksheet_SelectionChange(ByValTargetAsRange)'鼠标选定触发
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- 编程 常用 代码