excelvba常用代码总结1

1、选中某sheetExcel VBA常用代码总结1改变背景色Ran ge(A1). = xlN oneColorl ndex 览无色01920白色2122324725,26538394041424344454647卿4950515253545556改变文字颜色Ran ge(A1). =1获取单元格Cells( 1, 2)Ran ge(H7)获取范围Range(Cells( 2, 3), Cells( 4, 5)Range(a1:c3)用快捷记号引用单元格Worksheets( Sheet1 ).A1:B5Set NewSheet = Sheets( sheetl)选中或激活某单元格“Rangd对

2、象的的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 换成 thisworkbook隐藏文档=False禁止屏幕更新=Fals

3、e禁止显示提示和警告消息False文件夹选择框方法 2 (推荐)strPath = C:tempMkDir strPath状态栏文字表示=计算中双击单元格内容变换Private Sub Worksheet_BeforeDoubleClick( ByVai Target As Range, Cancel AsBoolea n)If =5 And = 8) ThenIf = ThenIlliElse= End IfCan cel =TrueEnd IfEnd Sub文件夹选择框方法1Set objShell = CreateObject ()Set objFolder = (0,文件,0, 0)I

4、f Not objFolder Is NothingThen path= &end ifSet objFolder = Noth ingSet objShell = Nothi ngPublic Function ChooseFolder() As StringDim dlgOpe nAs FileDialogSet dlgOpe n = (msoFileDialogFolderPicker)With dlgOpe n.In itialFileName = &If .Show = - 1 ThenChooseFolder = .SelectedItems(1)End IfEnd WithSet

5、 dlgOpe n = Noth ingEnd Function使用方法例：Dim path As Stringpath = ChooseFolder()If path ThenMsgBoxopen folderEnd If文件选择框方法PleaseExte n AsPublic Function ChooseOneFile( Optional TitleStr As String choose a file , Optional TypesDec As String = *.* , Optional String = *.* ) As StringDim dlgOpe nAs FileDia

6、logSet dlgOpe n = (msoFileDialogFilePicker)With dlgOpe n.Title = TitleStr.TypesDec, Exte n.AIIowMultiSelect =Falsen itialFileName =If .Show = - 1 Then.AllowMultiSelect = TrueFor Each vrtSelectedItem In .SelectedltemsMsgBox P ath name: & vrtSelectedItemNext vrtSelectedItemChoose On eFile = .Selectedl

7、tems(1)End IfEnd WithSet dlgOpe n = Noth ingEnd Function某列到关键字为止循环方法1(假设关键字是en d)Set Curre ntCell = Ra nge(A1)Do While endSet Curre ntCell = (1,0)Loop某列到关键字为止循环方法2(假设关键字是空字符串)i = StartRowDo While Cells(i, 1) Illii = i +1LoopFor Each.Next循环(知道确切边界)For Each c In Worksheets( Sheetl ).Range( A1:D10 ).Ce

8、llsIf Abs Then = 0NextFor Each.Next 循环(不知道确切边界),在活动单元格周围的区域内循环For Each c In If Abs Then = 0Next某列有数据的最末行的行数的取得(中间不能有空行)Ion Row=1Do While Trim (Cells(lonRow,2 ).Value) Ion Row = Ion Row +1LoopIon Row11 = Ion Row11 -1A列有数据的最末行的行数的取得另一种方法Range( A65536).End(xlUp).Row将文字复制到剪贴板Dim MyData As DataObjectSet

9、MyData = NewDataObjectRan ge(H7).Value取得路径中的文件名Private Function GetFileName( ByVal s As String )Dim sname() As Stringsname =Split (s, )GetFileName = sn ame(UBo undsn ame)End Fun cti on取得路径中的路径名Private Function GetPathName(ByVal s As String )intFileNameStart =InStrRev (s, )GetPathName = Mid(s, 1, i n

10、tFileNameStart)End Fun cti on由模板sheet拷贝做成一个新的 sheet(template ).Copy After:=Set doc_s =newsheetname & Format(Now, yyyyMMddhhmmss选中当列的最后一个有内容的单元格(中间不能有空行)删除B3开始到B列最后一个有内容的单元格为止的所有内容Ran ge(B3 ).SelectRan ge(Select ion, (xlDow n).Select常量定义Private Const StartRow判断sheet是否存在As Integer =3Private Function l

11、sWorksheet( ByVal strSeetName As String ) As BooleanOn Error GoToErrHandleDim blnRet As Booleanbln Ret = IsNull(Worksheets(strSeetName)IsWorksheet = TrueExit FunctionErrHa ndle:IsWorksheet = FalseEnd Fun cti on向单元格中写入公式Worksheets( Sheetl ).Range( D6).Formula =二SUM(D2:D5)引用命名单元格区域Ran ge(!MyRa nge)Ra

12、nge(Sheet1!Sales选定命名的单元格区域Refere nce:= !MyRa nge或者worksheets( sheetname).range( rangename).select使用 Dictionary使用 Dictionary 需要添加参照 Microsoft Scripting RuntimeDim dic As NewDictionaryTable , Cards 前面是 Key 后面是 ValueSerial , serialnoNumber, surfaceMsgBox( Table)由 Key取得 Value(Table)判断某Key是否存在将EXCEL表格中的两

13、列表格插入到一个Dictionary 中函数：在ws工作表中，从iStartRow行开始到没有数据为止， iKeyCol右一列插入到一个字典中，并返回字典。Public Function SetDic(ws As Worksheet, iStartRow, iKeyCol As Dictio nary把iKeyCol列和As Integer )Dim dic As NewDictionaryDim i As Integeri = iStartRowDo Un til (i, iRuleCol).Value =If Not (i, iKeyCol).Value) Then(i, iKeyCol)

14、.Value, (i, iKeyCol +End If1).Valuei = i +LoopSet SetDic = dicEnd Fun cti on判断文件夹或文件是否存在文件夹If Dir (C:aaa , vbDirectory) = ThenMkDir C:aaaEnd If文件If Dir (C:aaa ) = Thenmsgbox 文件不存在end if一次注释多行视图-工具栏-编辑调出编辑工具栏，工具栏上有个“设置注释块”和“解除注释快”打开文件并将文件赋予到第一个参数wb中注意，这里的path是文件的完整路径，包括文件名。Public Function OpenWorkBoo

15、k(wbAs Workbook, path As String ) As BooleanOn Error GoToErrOpen WorkBook = TrueDim isWbOpened As BooleanisWbOpe ned = FalseDim fileName As StringfileName = GetFileName(path)check file is opened or eitherDim wbTemp As WorkbookFor Each wbTemp In WorkbooksIf = fileNameThe n isWbOpe ned = TrueNextope n

16、 fileIf isWbOpened = False ThenpathEnd IfSet wb = Workbooks(fileName)Exit FunctionErr:Ope nWorkBook = FalseEnd Fun cti on打开一个文件，并将文件赋予到 wb中，将文件的sheet页赋予到ws中的完整代码。 (用到了上面的函数)If OpenWorkBook(wb, path & & filename) = False ThenMsgBoxope n file error.GoToErrEnd IfSet ws = ( sheetname)打开一个不知道确切名字的文件(文件名中

17、含有serach name),并将文件赋予到 wb中，将文件的sheet页赋予到ws中的完整代码。0用到了上上面的函数 OpenWorkBookIf Ope nCompa nyFile(wb, path, search name) = False The nMsgBoxope n file error.GoToErrEnd IfSet ws = ( sheetname)直接使用的函数OpenCompanyFileFunction OpenCompanyFile(wbComAs Workbook, strPath As String , strFileName As String ) As Bo

18、oleanDim fs As Varia ntfs = Dir (strPath &*.xls) seach filesOpen Compa ny File =FalseDo While fs If In Str (1, fs, strFileName) 0 The n file name matchIf OpenWorkBook(wbCom, strPath & & fs) = False Then ope n fileFalseTrueOpen Compa ny File =Exit DoElseOpen Compa ny File =Exit DoEnd IfEnd Iffs = Dir

19、LoopEnd Fun cti on数字转字母(如1转成A, 2转成B)和字母转数字Chr(i +64)比如i=1的时候，Chr(i +64)=AAsc(i -64)比如i=A的时候，Asc(i -64)=1chec复选框总开关实现。假如有10个子checkbox1checkbox10，还有一个总开关kbox11，让checkbox 控制110的选择和非选择。Private Sub CheckBox11_Click()Dim chb As VariantIf = True ThenFor Each chb InIf Like CheckBox* And CheckBox11 Then=True

20、End IfNextElseFor Each chb InIf Like CheckBox* And CheckBox11 ThenFalseNextEnd IfEnd Sub修改B6单元格所在的pivot的数据源，并刷新 pivotSet pvt = ( B6).PivotTableSourceData:= _SheetName!R4C2:R & In gLastRow &C22,Versi on: =xlPivotTableVersi on 10)将一个图形(比如一个长方形的框Recta ngle 2)移动到与某个单元格对齐。=TrueRectangle 2 ).SelectRectang

21、le 2 ).Top = (T5 ).TopRectangle 2 ).Left = (T5 ).Left=False遍历控件。比如遍历所有的checkbox是否被打挑。If ( CheckBox & i). = True ThenflgChecked =Trueend if得到今天的日期dateNow = (Now(), YYYY/MM/DD在某个sheet页中查找某个关键字*Search keyword from a worksheet (not workbook!)*Public Function SearchKeyWord(ws As Worksheet, keyword As Str

22、ing ) AsBoolea nDim varl As Varia ntSet varl = After:=ActiveCell, Lookl n: =xlFormulas, LookAt _:=xlPart, SearchOrder:=xlByRows, SearchDirecti on: =xlNext,MatchCase:= _False , MatchByte:= False , SearchFormat:= False)If varl Is Nothing ThenSearchKeyWord =FalseElseSearchKeyWord =TrueEnd IfEnd Fun cti

23、 on单元格为空，取不到值的时候，转化为空字符串。Empty toykkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkEmpty to *Public Function ChangeEmptyToString(var As Variant)As StringOn Error GoToErrCha ngeEmptyToStri ng =CStr(var)Exit FunctionErr:Cha ngeEmptyToStri ng =IlliEnd Fun cti on单元格为空，取不到值的时候，转化为0。Empty to 0*Empty to

24、 0*Public Function ChangeEmptyToLong(var As Variant)As LongOn Error GoToErrChan geEmptyToL ong = CLng(var)Exit FunctionErr:Chan geEmptyToL ong =0End Fun cti on找到某个sheet页中使用的最末行遍历文件夹下的所有文件(自定义文件夹和后缀名)，并返回文件列表字典As String )Function SetFilesToDic( ByVai path As String , ByVai extensionAs Dictio naryDim

25、MyFile As StringDim s As StringDim count As IntegerDim dic As NewDictionaryIf Right (path, 1) Thenpath = path &End IfMyFile = Dir (path & *. & extension)count =1Do While MyFile If MyFile = The nExit DoEnd Ifcount, MyFilecount = count +1MyFile = DirLoopSet SetFilesToDic = dicsEnd Fun cti on生成logSub t

26、xtPrint( ByVal txt$,Optional myPath$ =)第 2 参数可以指定保存txt文件路径If myPath = Then myPath = &Ope n myPath For Appe nd As # 1Print # 1, txtClose #1End Sub  Non-Breaking Space网页空格在 VBA中的处理替换字符MidBChrB(160) & ChrB( 0)上述最终解决方法来自于 Sdany用户是通过如下思路找到解决方法的和 AscB):Dim I As IntegerFor I =1 To Len B(Cells( 1, 1)As

27、cB(MidB(Cells( 1, 1), I, 1)Next延时这段代码在Excel VBA和VB里都可以用*VB延时函数定义*声明Private Declare Function timeGetTime Lib () As Long延时Public Sub Delay( ByVal num As Integer )Dim t As Long t = timeGetTimeDo Until timeGetTime - t = num *1000DoEve ntsLoopEnd Sub*使用方法：delay 33表示秒数杀掉某程序执行的所有进程Sub KillWord()Dim ProcessFor Each