Excel VBA常用代码总结1讲解学习.docx
- 文档编号:157033
- 上传时间:2023-04-28
- 格式:DOCX
- 页数:23
- 大小:57.85KB
Excel VBA常用代码总结1讲解学习.docx
《Excel VBA常用代码总结1讲解学习.docx》由会员分享,可在线阅读,更多相关《Excel VBA常用代码总结1讲解学习.docx(23页珍藏版)》请在冰点文库上搜索。
ExcelVBA常用代码总结1讲解学习
ExcelVBA常用代码总结1
ExcelVBA常用代码总结1
∙改变背景色
Range("A1").Interior.ColorIndex=xlNone
ColorIndex一览
∙改变文字颜色
Range("A1").Font.ColorIndex=1
∙获取单元格
Cells(1,2)
Range("H7")
∙获取范围
Range(Cells(2,3),Cells(4,5))
Range("a1:
c3")
'用快捷记号引用单元格
Worksheets("Sheet1").[A1:
B5]
∙选中某sheet
SetNewSheet=Sheets("sheet1")
NewSheet.Select
∙选中或激活某单元格
'“Range”对象的的Select方法可以选择一个或多个单元格,而Activate方法可以指定某一个单元格为活动单元格。
'下面的代码首先选择A1:
E10区域,同时激活D4单元格:
Range("a1:
e10").Select
Range("d4:
e5").Activate
'而对于下面的代码:
Range("a1:
e10").Select
Range("f11:
g15").Activate
'由于区域A1:
E10和F11:
G15没有公共区域,将最终选择F11:
G15,并激活F11单元格。
∙获得文档的路径和文件名
ActiveWorkbook.Path '路徑
ActiveWorkbook.Name '名稱
ActiveWorkbook.FullName '路徑+名稱
'或将ActiveWorkbook换成thisworkbook
∙隐藏文档
Application.Visible=False
∙禁止屏幕更新
Application.ScreenUpdating=False
∙禁止显示提示和警告消息
Application.DisplayAlerts=False
∙文件夹做成
strPath="C:
\temp\"
MkDirstrPath
∙状态栏文字表示
Application.StatusBar="计算中"
∙双击单元格内容变换
PrivateSubWorksheet_BeforeDoubleClick(ByValTargetAsRange,CancelAsBoolean)
If(Target.Cells.Row>=5AndTarget.Cells.Row<=8)Then
IfTarget.Cells.Value="●"Then
Target.Cells.Value=""
Else
Target.Cells.Value="●"
EndIf
Cancel=True
EndIf
EndSub
∙文件夹选择框方法1
SetobjShell=CreateObject("Shell.Application")
SetobjFolder=objShell.BrowseForFolder(0,"文件",0,0)
IfNotobjFolderIsNothing
Thenpath=objFolder.self.Path&"\"
endif
SetobjFolder=Nothing
SetobjShell=Nothing
∙文件夹选择框方法2(推荐)
PublicFunctionChooseFolder()AsString
DimdlgOpenAsFileDialog
SetdlgOpen=Application.FileDialog(msoFileDialogFolderPicker)
WithdlgOpen
.InitialFileName=ThisWorkbook.path&"\"
If.Show=-1Then
ChooseFolder=.SelectedItems
(1)
EndIf
EndWith
SetdlgOpen=Nothing
EndFunction
'使用方法例:
DimpathAsString
path=ChooseFolder()
Ifpath<>""Then
MsgBox"openfolder"
EndIf
∙文件选择框方法
PublicFunctionChooseOneFile(OptionalTitleStrAsString="Pleasechooseafile",OptionalTypesDecAsString="*.*",OptionalExtenAsString="*.*")AsString
DimdlgOpenAsFileDialog
SetdlgOpen=Application.FileDialog(msoFileDialogFilePicker)
WithdlgOpen
.Title=TitleStr
.Filters.Clear
.Filters.AddTypesDec,Exten
.AllowMultiSelect=False
.InitialFileName=ThisWorkbook.Path
If.Show=-1Then
'.AllowMultiSelect=True
'ForEachvrtSelectedItemIn.SelectedItems
'MsgBox"Pathname:
"&vrtSelectedItem
'NextvrtSelectedItem
ChooseOneFile=.SelectedItems
(1)
EndIf
EndWith
SetdlgOpen=Nothing
EndFunction
∙某列到关键字为止循环方法1(假设关键字是end)
SetCurrentCell=Range("A1")
DoWhileCurrentCell.Value<>"end"
……
SetCurrentCell=CurrentCell.Offset(1,0)
Loop
∙某列到关键字为止循环方法2(假设关键字是空字符串)
i=StartRow
DoWhileCells(i,1)<>""
……
i=i+1
Loop
∙"ForEach...Next循环(知道确切边界)
ForEachcInWorksheets("Sheet1").Range("A1:
D10").Cells
IfAbs(c.Value)<0.01Thenc.Value=0
Next
∙"ForEach...Next循环(不知道确切边界),在活动单元格周围的区域内循环
ForEachcInActiveCell.CurrentRegion.Cells
IfAbs(c.Value)<0.01Thenc.Value=0
Next
∙某列有数据的最末行的行数的取得(中间不能有空行)
lonRow=1
DoWhileTrim(Cells(lonRow,2).Value)<>""
lonRow=lonRow+1
Loop
lonRow11=lonRow11-1
∙A列有数据的最末行的行数的取得另一种方法
Range("A65536").End(xlUp).Row
∙将文字复制到剪贴板
DimMyDataAsDataObject
SetMyData=NewDataObject
MyData.SetTextRange("H7").Value
MyData.PutInClipboard
∙取得路径中的文件名
PrivateFunctionGetFileName(ByValsAsString)
Dimsname()AsString
sname=Split(s,"\")
GetFileName=sname(UBound(sname))
EndFunction
∙取得路径中的路径名
PrivateFunctionGetPathName(ByValsAsString)
intFileNameStart=InStrRev(s,"\")
GetPathName=Mid(s,1,intFileNameStart)
EndFunction
∙由模板sheet拷贝做成一个新的sheet
ThisWorkbook.Worksheets("template").CopyAfter:
=ThisWorkbook.Worksheets(Sheets.Count)
Setdoc_s=ThisWorkbook.Worksheets(Sheets.Count)
doc_s.Name="newsheetname"&Format(Now,"yyyyMMddhhmmss")
∙选中当列的最后一个有内容的单元格(中间不能有空行)
'删除B3开始到B列最后一个有内容的单元格为止的所有内容
Range("B3").Select
Range(Selection,Selection.End(xlDown)).Select
Selection.ClearContents
∙常量定义
PrivateConstStartRowAsInteger=3
∙判断sheet是否存在
PrivateFunctionIsWorksheet(ByValstrSeetNameAsString)AsBoolean
OnErrorGoToErrHandle
DimblnRetAsBoolean
blnRet=IsNull(Worksheets(strSeetName))
IsWorksheet=True
ExitFunction
ErrHandle:
IsWorksheet=False
EndFunction
∙向单元格中写入公式
Worksheets("Sheet1").Range("D6").Formula="=SUM(D2:
D5)"
∙引用命名单元格区域
Range("MyBook.xls!
MyRange")
Range("[Report.xls]Sheet1!
Sales"
∙选定命名的单元格区域
Application.GotoReference:
="MyBook.xls!
MyRange"
'或者
worksheets("sheetname").range("rangename").select
Selection.ClearContents
∙使用Dictionary
'使用Dictionary需要添加参照MicrosoftScriptingRuntime
DimdicAsNewDictionary
dic.Add"Table","Cards"'前面是Key后面是Value
dic.Add"Serial","serialno"
dic.Add"Number","surface"
MsgBoxdic.Item("Table")'由Key取得Value
dic.Exists("Table")'判断某Key是否存在
∙将EXCEL表格中的两列表格插入到一个Dictionary中
'函数:
在ws工作表中,从iStartRow行开始到没有数据为止,把iKeyCol列和iKeyCol右一列插入到一个字典中,并返回字典。
PublicFunctionSetDic(wsAsWorksheet,iStartRow,iKeyColAsInteger)AsDictionary
DimdicAsNewDictionary
DimiAsInteger
i=iStartRow
DoUntilws.Cells(i,iRuleCol).Value=""
IfNotdic.Exists(ws.Cells(i,iKeyCol).Value)Then
dic.Addws.Cells(i,iKeyCol).Value,ws.Cells(i,iKeyCol+1).Value
EndIf
i=i+1
Loop
SetSetDic=dic
EndFunction
∙判断文件夹或文件是否存在
'文件夹
IfDir("C:
\aaa",vbDirectory)=""Then
MkDir"C:
\aaa"
EndIf
'文件
IfDir("C:
\aaa\1.txt")=""Then
msgbox"文件C:
\aaa\1.txt不存在"
endif
∙一次注释多行
视图---工具栏---编辑 调出编辑工具栏,工具栏上有个“设置注释块”和“解除注释快”
∙打开文件并将文件赋予到第一个参数wb中
'注意,这里的path是文件的完整路径,包括文件名。
PublicFunctionOpenWorkBook(wbAsWorkbook,pathAsString)AsBoolean
OnErrorGoToErr
OpenWorkBook=True
DimisWbOpenedAsBoolean
isWbOpened=False
DimfileNameAsString
fileName=GetFileName(path)
'checkfileisopenedoreither
DimwbTempAsWorkbook
ForEachwbTempInWorkbooks
IfwbTemp.Name=fileNameThenisWbOpened=True
Next
'openfile
IfisWbOpened=FalseThen
Workbooks.Openpath
EndIf
Setwb=Workbooks(fileName)
ExitFunction
Err:
OpenWorkBook=False
EndFunction
∙打开一个文件,并将文件赋予到wb中,将文件的sheet页赋予到ws中的完整代码。
(用到了上面的函数)
'IfOpenWorkBook(wb,path&"\"&"filename")=FalseThen
MsgBox"openfileerror."
GoToErr
EndIf
wb.Activate
Setws=wb.Worksheets("sheetname")
∙打开一个不知道确切名字的文件(文件名中含有serachname),并将文件赋予到wb中,将文件的sheet页赋予到ws中的完整代码。
'用到了上上面的函数OpenWorkBook
'IfOpenCompanyFile(wb,path,"searchname")=FalseThen
MsgBox"openfileerror."
GoToErr
EndIf
wb.Activate
Setws=wb.Worksheets("sheetname")
'直接使用的函数OpenCompanyFile
FunctionOpenCompanyFile(wbComAsWorkbook,strPathAsString,strFileNameAsString)AsBoolean
DimfsAsVariant
fs=Dir(strPath&"\*.xls")'seachfiles
OpenCompanyFile=False
DoWhilefs<>""
IfInStr(1,fs,strFileName)>0Then'filenamematch
IfOpenWorkBook(wbCom,strPath&"\"&fs)=FalseThen'openfile
OpenCompanyFile=False
ExitDo
Else
OpenCompanyFile=True
ExitDo
EndIf
EndIf
fs=Dir
Loop
EndFunction
∙数字转字母(如1转成A,2转成B)和字母转数字
Chr(i+64)
比如i=1的时候,Chr(i+64)=A
Asc(i-64)
比如i=A的时候,Asc(i-64)=1
∙复选框总开关实现。
假如有10个子checkbox1~checkbox10,还有一个总开关checkbox11,让checkbox11控制1~10的选择和非选择。
PrivateSubCheckBox11_Click()
DimchbAsVariant
IfMe.CheckBox11.Value=TrueThen
ForEachchbInActiveSheet.OLEObjects
Ifchb.NameLike"CheckBox*"Andchb.Name<>"CheckBox11"Then
chb.Object.Value=True
EndIf
Next
Else
ForEachchbInActiveSheet.OLEObjects
Ifchb.NameLike"CheckBox*"Andchb.Name<>"CheckBox11"Then
chb.Object.Value=False
EndIf
Next
EndIf
EndSub
∙修改B6单元格所在的pivot的数据源,并刷新pivot
Setpvt=ActiveSheet.Range("B6").PivotTable
pvt.ChangePivotCacheActiveWorkbook.PivotCaches.Create(SourceType:
=xlDatabase,SourceData:
=_
"SheetName!
R4C2:
R"&lngLastRow&"C22",Version:
=xlPivotTableVersion10)
pvt.PivotCache.Refresh
∙将一个图形(比如一个长方形的框"Rectangle2")移动到与某个单元格对齐。
ws.Activate
Application.ScreenUpdating=True
ws.Shapes.Range(Array("Rectangle2")).Select
ws.Shapes.Range(Array("Rectangle2")).Top=ws.Range("T5").Top
ws.Shapes.Range(Array("Rectangle2")).Left=ws.Range("T5").Left
Application.ScreenUpdating=False
∙遍历控件。
比如遍历所有的checkbox是否被打挑。
IfMe.OLEObjects("CheckBox"&i).Object.Value=TrueThen
flgChecked=True
endif
∙得到今天的日期
dateNow=WorksheetFunction.Text(Now(),"YYYY/MM/DD")
∙在某个sheet页中查找某个关键字
'****************************************************
'Searchkeywordfromaworksheet(notworkbook!
)
'****************************************************
PublicFunctionSearchKeyWord(wsAsWorksheet,keywordAsString)AsBoolean
Dimvar1AsVariant
Setvar1=ws.Cells.Find(What:
=keyword,After:
=ActiveCell,LookIn:
=xlFormulas,LookAt_
:
=xlPart,SearchOrder:
=xlByRows,SearchDirection:
=xlNext,MatchCase:
=_
False,MatchByte:
=False,SearchFormat:
=False)
Ifvar1IsNothingThen
SearchKeyWord=False
Else
SearchKeyWord=True
EndIf
EndFunction
∙单元格为空,取不到值的时候,转化为空字符串。
Emptyto""
'****************************************************
'Emptyto""
'****************************************************
PublicFunctionChangeEmptyToString(varAsVariant)AsString
OnErrorGoToErr
ChangeEmptyToString=CStr(var)
ExitFunction
Err:
ChangeEmptyToString=""
EndFunction
∙单元格为空,取不到值的时候,转化为0。
Emptyto0
'****************************************************
'Emptyto0
'****************************************************
PublicFunctionChangeEmptyToLong(varAsVariant)AsLong
OnErrorGoToErr
ChangeEmptyToLong=CLng(var)
ExitFunction
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- Excel VBA常用代码总结1讲解学习 VBA 常用 代码 总结 讲解 学习
![提示](https://static.bingdoc.com/images/bang_tan.gif)