VBA语句汇总Word文档格式.docx

1、）中的单元格上循环 下例用 For Each.Next 循环语句（yj）在命名区域中的每一个单元格上循环。如果该区域中的任一单元格的值超过 limit 的值，就将该单元格的颜色（yns）更改为黄色。Sub ApplyColor（） Const Limit As Integer = 25 For Each c In Range（MyRange） If c.Value Limit Then c.Interior.ColorIndex = 27 End If Next c 增加（zngji）一个workbooks, name Carrier Workbooks.Add ActiveWorkbook.

2、SaveAs Filename:=D:BOM Producecarrier.xls, FileFormat:= _ xlNormal, Password:, WriteResPassword:, ReadOnlyRecommended:=False _ , CreateBackup:增加一个（y ）表单，获取nameSheets.Addx = ActiveSheet.NameSheets（x）.Select插入一列 Range（E5）.Select Selection.EntireRow.Insert插入一栏F6 Selection.EntireColumn.Insert向右移动一格Activ

3、eCell.Offset（0, -1）.Select当前单元格当前（dngqin）单元格的值ActiveCell.FormulaR1C1 = “UseRow”复制（fzh）表单 Windows（spacebom.xls）.Activate Cells.Select Selection.CopyBomsetup.xls Sheets（Sheet2 ActiveSheet.PasteA1）单元格Akiko Resource Budget Plan.xlsBK71 Application.CutCopyMode = FalseBook1.xlsn）单元格整栏选择ActiveCell.EntireCo

4、lumn.Select、整栏复制（f）与粘贴Columns（C:C Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:两栏进行交换L:L Selection.Cut Columns（N:N Selection.Insert Shift:=xlToRightDelete:Rows（2:2Selection.Delete Shift:=xlUpRange（B4Selection.EntireRow.Delete每列从第k栏开始（kish）每5个一列进行（jn

5、xng）排列：bomsetup.xls Dim Counter As Integer For Counter = 2 To 1000 Cells（Counter, 11）.Select If ActiveCell.Value = Then ActiveCell.Offset（1, 0）.Select Else ActiveCell.Offset（1, -5）.Select ActiveCell.Offset（-1, 5）.Select Range（Selection, Selection.End（xlToRight）.Select End If Next Counter字体（zt）变色C3 S

6、election.Font.ColorIndex = 3单元格变背景色Selection.Interior.ColorIndex=3t）变粗D4 Selection.Font.Bold = True在B栏中查找（ch zho）是否有0000后B:BSet findxx = Selection.Find（0000）If findxx Is Nothing Then在B栏中查找0000后，向左移动一格 Selection.Find（What:, After:=ActiveCell, LookIn:=xlFormulas, LookAt _=xlPart, SearchOrder:=xlByRows

7、, SearchDirection:=xlNext, MatchCase: False, MatchByte:=False, SearchFormat:=False）.Activate ActiveCell.Offset（0, -1）.Select在c栏中找到N/a后用*替代（tdi） Selection.Replace What:n/a, Replacement:*, LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, _ ReplaceFormat:排序（pi xCells.Select Selection.Sort Key

8、1:=Range（A2）, Order1:=xlAscending, Key2:C2） _ , Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase: , Orientation:=xlTopToBottom, SortMethod:=xlStroke, DataOption1: xlSortNormal, DataOption2:=xlSortNormal自动（zdng）塞选 Selection.AutoFilter Selection.AutoFilter Field:=10 取消（qxio）赛选 第10栏=10, Cr

9、iteria1:#N/A, Operator:=xlAnd 第10栏选择（xunz）非#N/A自动运行FormPrivate Sub Workbook_Open（）你的窗体.Show调整宽度）.EntireColumn.AutoFit代表单元格区域A1:J10Range（Cells（1,1）,Cells（10,10）代表单元格区域区分颜色并删除SubFilterColor（） DimUseRow,AC UseRow=Cells.SpecialCells（xlCellTypeLastCell）.Row ACActiveCell.Column Fori1ToUseRow IfCells（i,AC）

10、.Interior.ColorIndexActiveCell.Interior.ColorIndexThen AC）.EntireRow.deleteEndIf Next Sub依次（yc）打开选定（xun dn）数据夹中的xls 文件（wn）Sub aa（）Dim myDialog As FileDialog, oFile As Object, strName As String, n As IntegerDim FSO As Object, myFolder As Object, myFiles As ObjectDim ySet myDialog = Application.FileDi

11、alog（msoFileDialogFolderPicker）n = 1With myDialogIf .Show -1 Then Exit SubSet FSO = CreateObject（Scripting.FileSystemObjectSet myFolder = FSO.GetFolder（.InitialFileName）Set myFiles = myFolder.FilesFor Each oFile In myFilesstrName = UCase（oFile.Name）strName = VBA.Right（strName, 3）If strName = XLSy =

12、oFile.NameWorkbooks.open Filename:=yn = n + 1End IfNextEnd WithSUM 变量（binling）引用Dim nRow1, nRow2 As IntegerDim nCol As IntegernRow1 = 2nRow2 = 11nCol = 4d12）.Formula = =sum（d & nRow1 & :d nRow2 &）或者（huzh）ActiveCell.FormulaR1C1 = =SUM（R-1C:R- J &C）XlDirection 可为 XlDirection 常量（chngling）之一。xlDown xlTo

13、Right xlToLeft xlUp 示例（shl本示例（sh）选定包含单元格 B4 的区域（qy）中 B 列顶端的单元格。）.End（xlUp）.Select本示例选定包含单元格 B4 的区域中第 4 行尾端的单元格。）.End（xlToRight）.Select从单元格 B4 延伸至第四行最后一个包含数据的单元格。, Range（）.End（xlToRight）.Select引用单元格的值Dim xxx xxx = Workbooks（condition.xls）.Worksheets（）.Range（）.Value加上格线Sub openfileonebyone（） With Sele

14、ction.Borders（xlEdgeLeft） .LineStyle = xlContinuous End With With Selection.Borders（xlEdgeTop） With Selection.Borders（xlEdgeBottom） With Selection.Borders（xlEdgeRight） With Selection.Borders（xlInsideVertical） With Selection.Borders（xlInsideHorizontal） End Sub）打开指定（zhdng）活页夹中的文件（w Dim x As Object Dim

15、 f, fs, i, ofile Set x = CreateObject（ Set f = x.GetFolder（test Set fs = f.Files For Each ofile In fs Workbooks.Open Filename:=ofile Next得到（d do）文件名Dim getlen, GetFilegetlen = Len（SrcFile.Name） the length of the nameGetFile = Mid（ofile.Name, 1, getlen - 4） deduct the last four bytes所在（suzi）sheet最后一行

16、Dim i As IntegerDim myarrmyarr = Array（opath1, opath2, opath3, opath4, opath5, dpath1, dpath2, dpath3, dpath4, dpath5） For i = 0 To 4mypath = myarr（i） 指定路径。depath = “D:” 指定（zhdng）路径。myname = Dir（depath, vbDirectory） 找寻（zhoxn）第一项。Do While myname 开始（kish）循环。 跳过当前的目录（ml）及上层目录。 If myname . And myname .

17、dnum = dnum + 1 myname = Dir 查找下一个（y ）目录。Loop显示 C: 目录下的名称。MyPath = c:MyName = Dir（MyPath, vbDirectory） 找寻第一项。Do While MyName 开始循环。 跳过当前的目录及上层目录。 If MyName And MyName 使用位比较来确定 MyName 代表一目录。 If （GetAttr（MyPath & MyName） And vbDirectory） = vbDirectory ThenDebug.Print MyName 如果它是一个目录，将其名称显示出来。 MyName =

18、Dir 查找下一个目录。Sub 统计显示所浏览的文件夹中某类文件的数量及文件名（）For zzzzz = 1 To 5jjjjj = Workbooks（Book4）.Sheets（1）.Cells（zzzzz, 1）Set X = CreateObject（Set F = X.GetFolder（jjjjj）Set FS = F.subfoldersFor Each ofile In FSi = i + 1Cells（i, 1） = ofile &ZWFor j = 1 To ieee = Sheets（sheet1）.Cells（j, 1）Set F = X.GetFolder（eee）S

19、et FS = F.Filesy = y + 1Cells（y, 1） = ofile.Namey = 0For k = 1 To iSheets（k）.SelectCells（1, 2）.SelectCells（1, 2） = Application.CountA（Range（Cells（1, 1）, Cells（5000, 1）Cells（1, 3） = Cells（Cells（1, 2）, 1）Cells（1, 4） = Left（Right（Cells（1, 3）, 8）, 4） - Cells（1, 2）If Cells（1, 4） 0 Then ActiveSheet.Tab.Co

20、lorIndex = 3Z = Z + Cells（1, 4）MsgBox Zselectioon.CopyFor ccccc = 1 To iSheets（1）.DeleteSheets（1）.Cells.Cleari = 0Z = 0添加（tin ji）图表 xxx = ActiveSheet.Shapes.AddChart.Name ActiveSheet.ChartObjects（xxx）.SelectActiveChart.SetSourceData Source:A3:F16COPY一栏到多栏 Rows（1）.Copy Destination:=.Rows（ SPfileexist

21、count + 1 & SPfileexistcount + Bomrtqty &For i = 1 To ActiveSheet.ChartObjects.Count MsgBox ActiveSheet.ChartObjects（i）.Name ActiveSheet.ChartObjects（1）.Activate ActiveSheet.ChartObjects（Chart 1=定制（dn zh）模块行为（1） Option Explicit 强制（qingzh）对模块内所有变量进行声明Option Private Module 标记（bioj）模块为私有，仅对同一工程中其它模块有用，

22、在宏对话框中不显示Option Compare Text 字符串不区分（qfn）大小写Option Base 1 指定数组的第一个下标为1（2） On Error Resume Next 忽略错误继续执行VBA代码,避免出现错误消息（3） On Error GoTo ErrorHandler 当错误发生时跳转到过程中的某个位置（4） On Error GoTo 0 恢复正常的错误提示（5） Application.DisplayAlerts=False 在程序执行过程中使出现的警告框不显示（6） Application.ScreenUpdating=False 关闭屏幕刷新Application.ScreenUpdating=True 打开屏幕刷新（7） Application.Enable.CancelKey=xlDisabled 禁用Ctrl+Break中止宏运行的功能工作簿（8） Workbooks.Add（） 创建一个新的工作簿（9） Workbooks（“book1.xls”）.Activate 激活名为book1的工作簿（10） ThisWorkbook.Save 保存工作簿（11） ThisWorkbook.close 关闭（gunb）当前工作簿（12