Excel VBA常用代码总结1

ExcelVBA常用代码总结1改变背景色Range(A1).Interior.ColorIndex=xlNoneColorIndex一览改变文字颜色Range(A1).Font.ColorIndex=1获取单元格Cells(1,2)Range(H7)获取范围Range(Cells(2,3),Cells(4,5))Range(a1:c3)'用快捷记号引用单元格Worksheets(Sheet1).[A1:B5]选中某sheetSetNewSheet=Sheets(sheet1)NewSheet.Select选中或激活某单元格'“Range”对象的的Select方法可以选择一个或多个单元格，而Activate方法可以指定某一个单元格为活动单元格。'下面的代码首先选择A1:E10区域，同时激活D4单元格：Range(a1:e10).SelectRange(d4:e5).Activate'而对于下面的代码：Range(a1:e10).SelectRange(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)ThenIfTarget.Cells.Value=●ThenTarget.Cells.Value=ElseTarget.Cells.Value=●EndIfCancel=TrueEndIfEndSub文件夹选择框方法1SetobjShell=CreateObject(Shell.Application)SetobjFolder=objShell.BrowseForFolder(0,文件,0,0)IfNotobjFolderIsNothingThenpath=objFolder.self.Path&\endifSetobjFolder=NothingSetobjShell=Nothing文件夹选择框方法2（推荐）PublicFunctionChooseFolder()AsStringDimdlgOpenAsFileDialogSetdlgOpen=Application.FileDialog(msoFileDialogFolderPicker)WithdlgOpen.InitialFileName=ThisWorkbook.path&\If.Show=-1ThenChooseFolder=.SelectedItems(1)EndIfEndWithSetdlgOpen=NothingEndFunction'使用方法例：DimpathAsStringpath=ChooseFolder()IfpathThenMsgBoxopenfolderEndIf文件选择框方法PublicFunctionChooseOneFile(OptionalTitleStrAsString=Pleasechooseafile,OptionalTypesDecAsString=*.*,OptionalExtenAsString=*.*)AsStringDimdlgOpenAsFileDialogSetdlgOpen=Application.FileDialog(msoFileDialogFilePicker)WithdlgOpen.Title=TitleStr.Filters.Clear.Filters.AddTypesDec,Exten.AllowMultiSelect=False.InitialFileName=ThisWorkbook.PathIf.Show=-1Then'.AllowMultiSelect=True'ForEachvrtSelectedItemIn.SelectedItems'MsgBoxPathname:&vrtSelectedItem'NextvrtSelectedItemChooseOneFile=.SelectedItems(1)EndIfEndWithSetdlgOpen=NothingEndFunction某列到关键字为止循环方法1(假设关键字是end)SetCurrentCell=Range(A1)DoWhileCurrentCell.Valueend……SetCurrentCell=CurrentCell.Offset(1,0)Loop某列到关键字为止循环方法2(假设关键字是空字符串)i=StartRowDoWhileCells(i,1)……i=i+1LoopForEach...Next循环(知道确切边界)ForEachcInWorksheets(Sheet1).Range(A1:D10).CellsIfAbs(c.Value)0.01Thenc.Value=0NextForEach...Next循环(不知道确切边界),在活动单元格周围的区域内循环ForEachcInActiveCell.CurrentRegion.CellsIfAbs(c.Value)0.01Thenc.Value=0Next某列有数据的最末行的行数的取得(中间不能有空行)lonRow=1DoWhileTrim(Cells(lonRow,２).Value)lonRow=lonRow+1LooplonRow11=lonRow11-1A列有数据的最末行的行数的取得另一种方法Range(Ａ65536).End(xlUp).Row将文字复制到剪贴板DimMyDataAsDataObjectSetMyData=NewDataObjectMyData.SetTextRange(H7).ValueMyData.PutInClipboard取得路径中的文件名PrivateFunctionGetFileName(ByValsAsString)Dimsname()AsStringsname=Split(s,\)GetFileName=sname(UBound(sname))EndFunction取得路径中的路径名PrivateFunctionGetPathName(ByValsAsString)intFileNameStart=InStrRev(s,\)GetPathName=Mid(s,1,intFileNameStart)EndFunction由模板sheet拷贝做成一个新的sheetThisWorkbook.Worksheets(template).CopyAfter:=ThisWorkbook.Worksheets(Sheets.Count)Setdoc_s=ThisWorkbook.Worksheets(Sheets.Count)doc_s.Name=newsheetname&Format(Now,yyyyMMddhhmmss)选中当列的最后一个有内容的单元格(中间不能有空行)'删除B3开始到B列最后一个有内容的单元格为止的所有内容Range(B3).SelectRange(Selection,Selection.End(xlDown)).SelectSelection.ClearContents常量定义PrivateConstStartRowAsInteger=3判断sheet是否存在PrivateFunctionIsWorksheet(ByValstrSeetNameAsString)AsBooleanOnErrorGoToErrHandleDimblnRetAsBooleanblnRet=IsNull(Worksheets(strSeetName))IsWorksheet=TrueExitFunctionErrHandle:IsWorksheet=FalseEndFunction向单元格中写入公式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).selectSelection.ClearContents使用Dictionary'使用Dictionary需要添加参照MicrosoftScriptingRuntimeDimdicAsNewDictionarydic.AddTable,Cards'前面是Key后面是Valuedic.AddSerial,serialnodic.AddNumber,surfaceMsgBoxdic.Item(Table)'由Key取得Valuedic.Exists(Table)'判断某Key是否存在将EXCEL表格中的两列表格插入到一个Dictionary中'函数：在ws工作表中，从iStartRow行开始到没有数据为止，把iKeyCol列和iKeyCol右一列插入到一个字典中，并返回字典。PublicFunctionSetDic(wsAsWorksheet,iStartRow,iKeyColAsInteger)AsDictionaryDimdicAsNewDictionaryDimiAsIntegeri=iStartRowDoUntilws.Cells(i,iRuleCol).Value=IfNotdic.Exists(ws.Cells(i,iKeyCol).Value)Thendic.Addws.Cells(i,iKeyCol).Value,ws.Cells(i,iKeyCol+1).ValueEndIfi=i+1LoopSetSetDic=dicEndFunction判断文件夹或文件是否存在'文件夹IfDir(C:\aaa,vbDirectory)=ThenMkDirC:\aaaEndIf'文件IfDir(C:\aaa\1.txt)=Thenmsgbox文件C:\aaa\1.txt不存在endif一次注释多行视图---工具栏---编辑调出编辑工具栏，工具栏上有个“设置注释块”和“解除注释快”打开文件并将文件赋予到第一个参数wb中'注意，这里的path是文件的完整路径，包括文件名。PublicFunctionOpenWorkBook(wbAsWorkbook,pathAsString)AsBooleanOnErrorGoToErrOpenWorkBook=TrueDimisWbOpenedAsBooleanisWbOpened=FalseDimfileNameAsStringfileName=GetFileName(path)'checkfileisopenedoreitherDimwbTempAsWorkbookForEachwbTempInWorkbooksIfwbTemp.Name=fileNameThenisWbOpened=TrueNext'openfile