[原创]VBA语句集100句(第4辑WordVBA)

VBA代码汇总Sub 批量超链接word文档()' 宏1 宏' 超链接Dim p$, f$, i As Integeri = 1p = "C:\Users\Administrator\Desktop\国创撰写\" & ""f = Dir(p & "*.docx") '取得第一个pdf文件名Do While f <> "" ' 循环语句ThisWorkbook.ActivateSheets(1).Cells(i, 1).Value = f 'Range("a1").Value = p & fActiveSheet.Hyperlinks.Add Anchor:=Cells(i, 2), Address:=p & f, _TextToDisplay:=f'MsgBox p & f 显示路径加文件名f = Dir '第二个文件名i = i + 1LoopEnd SubPrivate Sub CommandButton1_Click() 随机选择器Dim a, b, c, d As StringDim shu As IntegerDim arr(1 To 4)shu = Int((4 * Rnd) + 1)arr(1) = TextBox1.Valuearr(2) = TextBox2.Valuearr(3) = TextBox3.Valuearr(4) = TextBox4.ValueMsgBox "excel推荐你今天应该吃" & arr(shu)End SubPrivate Sub CommandButton2_Click() Unload MeEnd SubSub 批量新建指定名称工作簿() Application.DisplayAlerts = FalseFor i = 1 To 54 ' 个数减一Dim Rng As StringDim abc As RangeDim wb As WorkbookDim wb1 As WorkbookSet wb1 = ThisWorkbookWith ActiveCellRng = .ValueSet abc = .Offset(1, 0)End WithDim a As RangeDim b As Longb = 0For Each a In Range("E:E")If a.Value = Rng Thenb = b + 1End IfNextActiveCell.Offset(b, 0).EntireRow.Select Selection.Insert Shift:=xlDown Selection.Insert Shift:=xlDownabc.SelectRange("A1").EntireRow.Copy abc.Offset(b, -4) Set wb = Workbooks.Add'Filename:=ThisWorkbook.Path & Application.PathSeparator & Rng & ".xls"wb1.Sheets(1).Activateabc.CurrentRegion.Copywb.Sheets(1).Activatewb.Sheets(1).Pastewb.SaveAs "C:\Users\Administrator\Desktop\团队人员统计\" & Rng & ".xlsx" '之前忘了保存了wb.Closewb1.Sheets(1).Activateabc.Offset(b + 1, 0).SelectNextApplication.DisplayAlerts = TrueEnd SubSub 输入输出()Dim abc As Stringabc = InputBox("你想问什么", "这是一个标题")Call MsgBox("房主你最帅^ ^", 0, "这是标题")'加了括号一定要返回值，或者加call'Dim wb As Workbook' Set wb = Workbooks.Add' wb.SaveAs Filename:=ThisWorkbook.Path & Application.PathSeparator & "woshi.xls" '搞定名称啦！Sub 自动分组打印6_Click()For i = 1 To 35Dim Rng As StringDim abc As RangeWith ActiveCellRng = .ValueSet abc = .Offset(1, 0)End WithDim a As RangeDim b As Integerb = 0For Each a In Range("A:A")If a.Value = Rng Thenb = b + 1End IfNext' MsgBox bActiveCell.Offset(b, 0).EntireRow.SelectSelection.Insert Shift:=xlDownSelection.Insert Shift:=xlDownabc.SelectWorksheets("团队出勤").PageSetup.PrintArea = abc.CurrentRegion.AddressWorksheets("团队出勤").PrintOutRange("a1").EntireRow.Copy abc.Offset(b, 0)abc.Offset(b + 1, 0).SelectNextEnd SubPublic Sub多个工作表复制汇总()Dim p$, f$, z$, i As IntegerDim wb As WorksheetDim wb1 As WorkbookDim rng As RangeApplication.ScreenUpdating = FalseSet wb = ThisWorkbook.Worksheets(1)' p = "D:\学习\大二下\srp创新网络与创新绩效\新建文件夹\第五阶段数据编码47—80\第四阶段数据编码47—80\" & ""f = Dir(ThisWorkbook.Path & "\*.xls") '取得第一个excel文件名Do While f <> "" ' 循环语句Set rng = wb.Range("A1048576").End(xlUp).Offset(1, 0) ' ‘Set wb1 = "D:\学习\大二下\srp创新网络与创新绩效\新建文件夹\第五阶段数据编码47—80\第四阶段数据编码47—80\" & f z = ThisWorkbook.Path & "\" & fSet wb1 = GetObject(z)wb1.Sheets(2).ActivateColumns("Q:Q").SelectSelection.AutoFilter '筛选已验证过没问题ActiveSheet.Range("Q:Q").AutoFilter Field:=1, Criteria1:="发明申请"Rows("2:2").SelectSelection.Insert Shift:=xlDownRange("a3").CurrentRegion.Copy rngwb1.Close False'wb.Activate' Set rng = wb.Worksheets(1).Range("A1048576").End(xlUp).Offset(1, 0) ' rng.PasteSpecial Paste:=xlPasteValues'Range("a1").Value = p & f'MsgBox p & f 显示路径加文件名f = Dir '第二个文件名LoopApplication.ScreenUpdating = TrueEnd SubSub 股票分类建立工作表()Application.DisplayAlerts = FalseDim Rng As StringDim abc As RangeDim b As IntegerDim a As RangeDim sht As WorksheetRng = Worksheets("沪深300成分股10年").Range("b2").Value Set abc = Worksheets("沪深300成分股10年").Range("b2") Do While Rng <> ""b = 0For Each a In Range("b:b")If a.Value = Rng Thenb = b + 1End IfNextWorksheets("沪深300成分股10年").Activateabc.Offset(b, 0).EntireRow.SelectSelection.Insert Shift:=xlDownSet sht = Worksheets.Add/doc/a711863622.html, = Rng Worksheets("沪深300成分股10年").Activateabc.CurrentRegion.Copy sht.Range("a1")Set abc = abc.Offset(b + 1, 0)Rng = abc.ValueLoopEnd SubSub 遍历工作表求偏度峰度For Each sheet In Sheetssheet.SelectActiveSheet.Range("F1").SelectActiveCell.FormulaR1C1 = "=LN(RC[-2]/RC[-1])"Set rng = ActiveSheet.Range("A1048576").End(xlUp)a = rng.RowActiveSheet.Range("F2").SelectActiveCell.FormulaR1C1 = "=LN(RC[-2]/R[-1]C[-2])"ActiveSheet.Range("F2").SelectSelection.AutoFill Destination:=Range("F2:F" & a)ActiveSheet.Range("F2:F" & a).SelectActiveSheet.Range("G1").SelectActiveCell.FormulaR1C1 = "=KURT(C[-1])"ActiveSheet.Range("H1").SelectActiveCell.FormulaR1C1 = "=SKEW(C[-2])"NextEnd SubSub 求单只股票每一年风度偏度()'Sub 每年()'' 每年宏Dim rng, rng1, rng2 As RangeDim a, c, e, d As StringDim sheet As WorksheetDim b, i, f As LongApplication.ScreenUpdating = falseFor Each sheet In Sheetssheet.Select'选中活动工作表‘k= ActiveSheet.Range("A1").CurrentRegion.Rows.Count ‘ 取得最后一行的行号k 为longSet rng = ActiveSheet.Range("A1048576").End(xlUp) '获得最后一个非空单元格a = rng.Row '非空单元格的行号ActiveSheet.Range("j1").SelectActiveCell.FormulaR1C1 = "=TEXT(RC[-7],""yyyy"")" 'j1输入文本Range("J1").SelectSelection.AutoFill Destination:=Range("J1:J" & a) '自动填充所有行Set rng1 = ActiveSheet.Range("j1")i = 1Do While rng1 <> ""c = rng1.Rowb = 0For Each rng2 In Range("j:j")If rng2.Value = rng1.value Thenb = b + 1End IfNext '获得每一年的个数d = rng1.Offset(b - 1, 0).Rowe = rng1.ValueActiveSheet.Cells(i, 11).Value = eActiveSheet.Cells(i, 12).Value = Application.WorksheetFunction.Kurt(sheet.Range("F" & c & ":F" & d))ActiveSheet.Cells(i, 13).Value = Application.WorksheetFunction.Skew(sheet.Range("F" & c & ":F" & d)) '计算i = i + 1Set rng1 = rng1.Offset(b, 0)LoopnextApplication.ScreenUpdating = True-探戈写的代码：Sub test2()Dim Filename As String, wb As Workbook, Erow As Long, fn As String, bj As Variant, i As Long, k As Long, j As Long, l As Long Filename = Dir(ThisWorkbook.Path & "\*.xls")Do While Filename <> ""If Filename <> /doc/a711863622.html, Thenfn = ThisWorkbook.Path & "\" & FilenameWorkbooks.Open (fn)With ActiveWorkbook.Worksheets(1)Cells(65536, "A").End(xlUp).EntireRow.DeleteErow = Cells(65536, "C").End(xlUp).RowCells(3, "F").FormulaR1C1 = "=Year(RC[-3])"Cells(3, "F").AutoFill Destination:=Range(Cells(3, "F"), Cells(Erow, "F"))Cells(1, "G") = "年份"Cells(1, "H") = "峰度"Cells(1, "I") = "偏度"i = 3l = 3bj = Cells(i, "F").Valuek = 2007j = 3Do While k <> 2018Do While bj = kbj = Cells(i, "F").Valuei = i + 1LoopCells(j, "H").Formula = "=KURT(R" & l & "C5:R" & i & "C5)"Cells(j, "I").Formula = "=SKEW(R" & l & "C5:R" & i & "C5)"Cells(j, "G").Value = kl = i + 1k = k + 1j = j + 1LoopEnd WithActiveWorkbook.Close savechanges:=TrueEnd IfFilename = DirLoopEnd Sub使用cells.formula 调用工作表函数Cells(1, 1).Formula = "=sum（d" & l & ":d3) "Sub 计算个股（单个工作簿工作表）的收益率和偏度峰度a()'Sub 计算偏度峰度a()'' 每年宏Dim rng, rng1, rng2, rng3 As RangeDim a, c, e, d As StringDim sheet As WorksheetDim b, i, f, k As LongDim filename, fn As Stringfilename = Dir(ThisWorkbook.Path & "\*.xls")Application.ScreenUpdating = FalseDo While filename <> ""If filename <> /doc/a711863622.html, Thenfn = ThisWorkbook.Path & "\" & filenameWorkbooks.Open (fn)ActiveWorkbook.Worksheets(1).SelectActiveSheet.Range("g2").Value = "长期收益率"ActiveSheet.Range("h2").Value = "长期峰度"ActiveSheet.Range("i2").Value = "长期偏度"ActiveSheet.Range("l2").Value = "每年收益率"ActiveSheet.Range("m2").Value = "每年峰度"ActiveSheet.Range("n2").Value = "每年偏度"ActiveSheet.Range("e3").SelectActiveCell.FormulaR1C1 = "=LN(RC[-1]/R[-1]C[-1])"k = ActiveSheet.Range("A1").CurrentRegion.Rows.CountActiveSheet.Range("e3").SelectSelection.AutoFill Destination:=Range("e3:e" & k)ActiveSheet.Cells(3, 8).Formula = "=KURT（e3:e" & k & ") " '算十年ActiveSheet.Cells(3, 9).Formula = "=skew(e3：e" & k & ") "ActiveSheet.Cells(3, 7).Formula = "=d" & k & "/d2 -1 "'选中活动工作表'非空单元格的行号ActiveSheet.Range("j3").SelectActiveCell.FormulaR1C1 = "=TEXT(RC[-7],""yyyy"")" 'j1输入文本Range("J3").SelectSelection.AutoFill Destination:=Range("J3:J" & k) '自动填充所有行Set rng1 = ActiveSheet.Range("j3")i = 3Do While rng1 <> ""c = rng1.Rowb = 0For Each rng2 In Range("j:j")If rng2.Value = rng1.Value Thenb = b + 1Next '获得每一年的个数d = rng1.Offset(b - 1, 0).Rowe = rng1.ValueActiveSheet.Cells(i, 11).Value = eActiveSheet.Cells(i, 13).Formula = "=KURT（e" & c & ":e" & d & ") "ActiveSheet.Cells(i, 14).Formula = "=skew（e" & c & ":e" & d & ") "ActiveSheet.Cells(i, 12).Formula = "=d" & d & "/d" & c & "-1 "i = i + 1Set rng1 = rng1.Offset(b, 0)LoopActiveWorkbook.Close savechanges:=TrueEnd Iffilename = DirLoopApplication.ScreenUpdating = TrueEnd Sub------------批量总表Dim a, c, e, d As StringDim sheet As WorksheetDim b, i, f, k As LongDim filename, fn As Stringfilename = Dir(ThisWorkbook.Path & "\*.xls")Application.ScreenUpdating = FalseSet rng1 = ThisWorkbook.Sheets(1).Range("a1048576").End(xlUp).Offset(1, 0)Do While filename <> ""If filename <> /doc/a711863622.html, Thenfn = ThisWorkbook.Path & "\" & filenameWorkbooks.Open (fn)ActiveWorkbook.Worksheets(1).SelectWith ActiveWorkbook.Worksheets(1).Range("b2").CopyThisWorkbook.Sheets(1).Cells(i, 1).PasteSpecial xlPasteValues.Range("g3:i3").CopyThisWorkbook.Sheets(1).Cells(i, 2).PasteSpecial xlPasteValuesEnd WithActiveWorkbook.Close savechanges:=TrueEnd Ifi= i+1filename = DirLoopApplication.ScreenUpdating = TrueEnd SubPublic Sub 汇总工作簿的不同工作表()Dim f$, z$, i As Long '定义变量Dim wb As WorksheetDim wb1 As WorkbookDim rng As RangeApplication.ScreenUpdating = False ’关闭屏幕更新，加快运行速度Set wb = ThisWorkbook.Worksheets(1) '定义代码所在工作簿的变量f = Dir(ThisWorkbook.Path & "\*.xls") '取得所在文件夹的第一个excel 文件名Do While f <> "" ' 循环语句If f <> /doc/a711863622.html, Then ’判断该文件是否是代码所在工作簿Set rng = wb.Range("A1048576").End(xlUp).Offset(1, 0) '取得所要汇总的工作簿的A列第一个非空单元格z = ThisWorkbook.Path & "\" & fSet wb1 = Workbooks.Open(z) ’打开其他的工作簿wb1.Sheets(1).Range("B6").CurrentRegion.Copy rng '开始复制其他工作簿的内容到指定位置。

vba编程代码大全VBA编程代码大全。

VBA是Visual Basic for Applications的缩写，是一种用于Microsoft Office应用程序的编程语言。

通过VBA，用户可以编写自定义的宏和程序，以实现自动化操作和定制功能。

VBA编程在Excel、Word、PowerPoint等Office应用中都有广泛的应用，可以大大提高工作效率和数据处理的灵活性。

本文将为大家详细介绍VBA 编程中常用的代码，帮助大家更好地掌握VBA编程技能。

一、基本操作。

1. 打开VBA编辑器。

在Office应用程序中，按下Alt + F11快捷键即可打开VBA编辑器。

在VBA 编辑器中，可以编写和管理VBA代码。

2. 编写子程序。

使用Sub关键字定义一个子程序，然后在其中编写具体的VBA代码。

例如：Sub HelloWorld()。

MsgBox "Hello, World!"End Sub。

3. 运行宏。

在VBA编辑器中，可以直接运行编写好的宏程序。

也可以在Office应用程序中，通过快捷键或菜单来运行宏。

二、常用代码。

1. 操作单元格。

在Excel中，可以使用VBA来操作单元格，例如：Range("A1").Value = 100。

Range("A1").Interior.Color = RGB(255, 0, 0)。

2. 循环结构。

使用VBA可以编写各种类型的循环结构，例如For循环、Do While循环等，来实现对数据的遍历和处理。

3. 条件判断。

VBA中的If语句可以用来进行条件判断，根据不同的条件执行不同的操作，例如：If Range("A1").Value > 0 Then。

Range("B1").Value = "Positive"Else。

Range("B1").Value = "Negative"End If。

VBA常用语句（with语句）观察一下我们做合并工作表以及一些其它任务的VBA代码就会发现，我们经常能看到一些语句，例如：ifend if之类的固定语句，这些就是VBA中常用的基本语句。

这些语句可以实现循环、逻辑判断等等目的。

VBA中的语句有70多种，今天我们学习最常用的四种语句中的第一种。

1、With语句正常情况下我们完成下列需求：选择单元格A1，设置字体加粗，倾斜，加下划线，底色为黄色。

代码如下：Sub 宏1(）Range('A1').Font.Bold = TrueRange('A1').Font.Italic = TrueRange('A1').Font.Underline = xlUnderlineStyleSingleRange('A1').Interior.Color = 65535End Sub对象.属性.属性值这样，每个属性前面的对象都要重复写。

用with正好可以解决这个事情。

结构如下：with 对象.属性1=属性值.属性2=属性值.属性3=属性值…….属性N=属性值end with上面代码修改后如下：Sub 宏2()With Range('A1').Font.Bold = True.Font.Italic = True.Font.Underline = xlUnderlineStyleSingle.Interior.Color = 65535End WithEnd Sub这样就可以避免每次都要重复写对象了。

今天的分享就到这里。

只要你行动，离梦想就会更近一步，欢迎加入我们的学习行列，经常问问题的同学也希望你能转发、分享、赞赏，帮助别人也是在帮自己。

想报名参加培训的同学请联系本人微信：527240310，针对你日常工作中遇到的问题进行培训，培训时会发你素材，同步操作，让你真正学明白。

一次报名后，后期录制的所有视频均可免费观看。

常用语句‎(1).工‎作簿1.‎O n Er‎r or R‎e sume‎Next‎‎‎‎‎‎ '忽‎略错误继续‎执行VBA‎代码,避免‎出现错误消‎息2.O‎n Err‎o r Go‎T o Er‎r orHa‎n dler‎‎‎‎‎ '当错‎误发生时跳‎转到过程中‎的某个位置‎3.Ap‎p lica‎t ion.‎D ispl‎a yAle‎r ts=F‎a lse ‎‎‎‎'在程序‎执行过程中‎使出现的警‎告框不显示‎4.Ap‎p lica‎t ion.‎S cree‎n Upda‎t ing=‎F alse‎‎‎‎'关闭屏‎幕刷新‎Appl‎i cati‎o n.Sc‎r eenU‎p dati‎n g=Tr‎u e ‎‎‎ '‎打开屏幕刷‎新5.A‎c tive‎W orkb‎o ok.n‎a me ‎‎‎‎‎‎ '返回‎活动工作薄‎的名称6‎.Acti‎v eWor‎k book‎.Wind‎o wSta‎t e=xl‎M axim‎i zed ‎‎ '‎将当前工作‎簿最大化‎7.She‎e ts(S‎h eet1‎).Nam‎e= “S‎u m” ‎‎‎‎‎'将She‎e t1命名‎为Sum‎8.Wor‎k shee‎t s(Ar‎r ay(“‎s heet‎1”,”s‎h eet2‎”)).S‎e lect‎‎'同时选择‎工作表1和‎工作表2‎9.Act‎i veSh‎e et.U‎s edRa‎n ge.F‎o rmat‎C ondi‎t ions‎.Dele‎t e ‎'删除当前‎工作表中所‎有的条件格‎式10.‎A ctiv‎e Shee‎t.Pag‎e Setu‎p.Ori‎e ntat‎i on=x‎l Land‎s cape‎或Acti‎v eShe‎e t.Pa‎g eSet‎u p.Or‎i enta‎t ion=‎2 '将‎页面设置更‎改为横向‎11.Ce‎l ls.S‎e lect‎‎‎‎‎'选定当前‎工作表的所‎有单元格‎12.Ra‎n ge(“‎A1”).‎C lear‎C onte‎n ts ‎‎'清除活动‎工作表上单‎元格A1中‎的内容‎ Sel‎e ctio‎n.Cle‎a rCon‎t ents‎‎ '‎清除选定区‎域内容‎ Ran‎g e(“A‎1:D4”‎).Cle‎a r ‎‎ '‎彻底清除A‎1至D4单‎元格区域的‎内容，包括‎格式13‎.Acti‎v eCel‎l.Off‎s et(1‎,0).S‎e lect‎‎‎‎‎‎‎‎‎'活动单‎元格下移一‎行，同理，‎可下移一列‎R‎a nge(‎“A1”)‎.Offs‎e t(Co‎l umnO‎f fset‎:=1) ‎或 Ran‎g e(“A‎1”).O‎f fset‎(,1) ‎‎ '偏‎移一列‎ Ran‎g e(“A‎1”).O‎f fset‎(Rowo‎f fset‎:=-1)‎或 Ra‎n ge(“‎A1”).‎O ffse‎t(-1)‎‎‎'向上偏‎移一行1‎4.Act‎i veWi‎n dow.‎R ange‎S elec‎t ion.‎V alue‎=XX ‎‎‎‎‎‎‎ '将值‎X X输入到‎所选单元格‎区域中1‎5.Act‎i veWi‎n dow.‎R ange‎S elec‎t ion.‎C ount‎‎‎‎‎‎‎‎ '活动‎窗口中选择‎的单元格数‎16.R‎a nge(‎“A1”)‎.Inte‎r ior.‎C olor‎I ndex‎或 Ce‎l ls(1‎,1).I‎n teri‎o r.Co‎l orIn‎d ex ‎ '获‎取单元格A‎1背景色‎17.Na‎m es.A‎d d Na‎m e:=”‎M yArr‎a y”,R‎e fers‎T o:=A‎r rayN‎u m ‎‎‎‎‎ '将‎数组Arr‎a yNum‎命名为My‎A rray‎18.N‎a mes.‎A dd N‎a me:=‎”Prod‎u ceNu‎m”:,R‎e fers‎T o:=”‎=$B$1‎”,Vis‎i ble:‎=Fals‎e‎ '‎将名称隐藏‎19.C‎e lls(‎8,8).‎F ormu‎l aArr‎a y=”=‎S UM(R‎2C[-1‎]:R[-‎1]C[-‎1]*R2‎C:R[-‎1]C)”‎‎ '‎在单元格中‎输入数组公‎式。

本文的对象是：有一定Excel VBA基础，对Word VBA还没有什么认识，想在Excel 中通过VBA操作Word还有困难的人。

一、新建Word引用需要首先创建一个对Word Application 对象的引用。

在VBA中，工具-引用，选取“MicroSoft Word 11.0 Object Library”。

方法一、New Word.ApplicationDim Wordapp As Word.ApplicationSet Wordapp = NewWord.ApplicationWordapp.Visible = True '可见'Wordapp.ScreenUpdating =False '屏幕刷新Dim WordD As Word.Document '定义word类Set WordD = Wordapp.Documents.Add '新建文档‘Set WordD = Wordapp.Documents.open(filename)'打开文档……WordD.Close '关闭文档Set WordD = NothingWordApp.Quit '退出Word对象方法二、CreateObjectDim WordApp As ObjectSet WordApp =CreateObject("Word.Application") '新建Word对象‘后续操作及退出一样……方法三、GetObject文件已打开的情况下，使用：SetWordD=GetObject(filename)，可建立对文档的引用，如果文件没有打开，则还需要先用方法一或二来操作。

至于方法一和方法二的区别，在网上询问了一下，大师们的回答是：方法一：前期绑定,好处是在对象后输入句点可以给出快速提示，因为需要先引用对象，所以容易出现版本兼容问题。

[VBA] 语法200句定制模块行为(1) Option Explicit '强制对模块内所有变量进行声明Option Private Module '标记模块为私有，仅对同一工程中其它模块有用，在宏对话框中不显示 Option CompareText '字符串不区分大小写Option Base 1 '指定数组的第一个下标为1(2) On Error Resume Next '忽略错误继续执行VBA代码,避免出现错误消息(3) On Error GoToErrorHandler '当错误发生时跳转到过程中的某个位置(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 '关闭当前工作簿(12)ActiveWorkbook.Sheets.Count '获取活动工作薄中工作表数(13) '返回活动工作薄的名称(14) 『返回当前工作簿名称ThisWorkbook.FullName 『返回当前工作簿路径和名称(15)ActiveWindow.EnableResize=False 『禁止调整活动工作簿的大小(16)Application.Window.Arrange xlArrangeStyleTiled 『将工作簿以平铺方式排列(17) ActiveWorkbook.WindowState=xlMaximized『将当前工作簿最大化工作表(18)edRange.Rows.Count 『当前工作表中已使用的行数(19) Rows.Count 『获取工作表的行数(注：考虑向前兼容性)(20) Sheets(Sheet1).Name= 「Sum」 '将Sheet1命名为Sum(21) ThisWorkbook.Sheets.AddBefore:=Worksheets(1) '添加一个新工作表在第一工作表前(22) ActiveSheet.MoveAfter:=ActiveWorkbook. _Sheets(ActiveWorkbook.Sheets.Count)'将当前工作表移至工作表的最后(23) Worksheets(Array(「sheet1」,」sheet2」)).Select '同时选择工作表1和工作表2(24) Sheets(「sheet1」).Delete或 Sheets(1).Delete '删除工作表1(25) ActiveWorkbook.Sheets(i).Name'获取工作表i的名称(26)ActiveWindow.DisplayGridlines=Not ActiveWindow.DisplayGridlines '切换工作表中的网网格线显示，这种方法也可以用在其它方面进行相互切换，即相当于开关按钮(27)ActiveWindow.DisplayHeadings=Not ActiveWindow.DisplayHeadings 『切换工作表中的行列边框显示(28)edRange.FormatConditions.Delete 『删除当前工作表中所有的条件格式(29) Cells.Hyperlinks.Delete 『取消当前工作表所有超链接(30)ActiveSheet.PageSetup.Orientation=xlLandscape或ActiveSheet.PageSetup.Orientation=2'将页面设置更改为横向(31)ActiveSheet.PageSetup.RightFooter=ActiveWorkbook.FullName 『在页面设置的表尾中输入文件路径ActiveSheet.PageSetup.LeftFooter=erName『将用户名放置在活动工作表的页脚单元格/单元格区域(32)ActiveCell.CurrentRegion.Select或Range(ActiveCell.End(xlUp),ActiveCell.End(xlDown)).Select'选择当前活动单元格所包含的范围，上下左右无空行(33) Cells.Select 『选定当前工作表的所有单元格(34) Range(「A1」).ClearContents '清除活动工作表上单元格A1中的内容Selection.ClearContents '清除选定区域内容Range(「A1:D4」).Clear '彻底清除A1至D4单元格区域的内容，包括格式(35) Cells.Clear '清除工作表中所有单元格的内容(36)ActiveCell.Offset(1,0).Select '活动单元格下移一行，同理，可下移一列(37) Range(「A1」).Offset(ColumnOffset:=1)或Range(「A1」).Offset(,1)『偏移一列 Range(「A1」).Offset(Rowoffset:=-1)或Range(「A1」).Offset(-1) 『向上偏移一行(38) Range(「A1」).Copy Range(「B1」) '复制单元格A1，粘贴到单元格B1中Range(「A1:D8」).Copy Range(「F1」) '将单元格区域复制到单元格F1开始的区域中Range(「A1:D8」).Cut Range(「F1」) '剪切单元格区域A1至D8，复制到单元格F1开始的区域中Range(「A1」).CurrentRegion.CopySheets(「Sheet2」).Range(「A1」) '复制包含A1的单元格区域到工作表2中以A1起始的单元格区域中注：CurrentRegion属性等价于定位命令，由一个矩形单元格块组成，周围是一个或多个空行或列(39)ActiveWindow.RangeSelection.Value=XX '将值XX输入到所选单元格区域中(40)ActiveWindow.RangeSelection.Count '活动窗口中选择的单元格数(41) Selection.Count '当前选中区域的单元格数(42)GetAddress=Replace(Hyperlinkcell.Hyperlinks(1).Address,mailto:,」」) 『返回单元格中超级链接的地址并赋值(43) TextColor=Range(「A1」).Font.ColorIndex 『检查单元格A1的文本颜色并返回颜色索引 Range(「A1」).Interior.ColorIndex 『获取单元格A1背景色(44) cells.count 『返回当前工作表的单元格数(45) Selection.Range(「E4」).Select 『激活当前活动单元格下方3行，向右4列的单元格(46) Cells.Item(5,」C」) 『引单元格C5Cells.Item(5,3) 『引单元格C5(47) Range(「A1」).Offset(RowOffset:=4,ColumnOffset:=5)或 Range(「A1」).Offset(4,5) 『指定单元格F5(48) Range(「B3」).Resize(RowSize:=11,ColumnSize:=3)Rnage(「B3」).Resize(11,3) 『创建B3：D13区域(49) Range(「Data」).Resize(,2) 『将Data区域扩充2列(50) Union(Range(「Data1」),Range(「Data2」)) 『将Data1和Data2区域连接(51) Intersect(Range(「Data1」),Range(「Data2」)) 『返回Data1和Data2区域的交叉区域(52) Range(「Data」).Count 『单元格区域Data中的单元格数Range(「Data」). Columns.Count 『单元格区域Data中的列数Range(「Data」). Rows.Count 『单元格区域Data中的行数(53) Selection.Columns.Count 『当前选中的单元格区域中的列数Selection.Rows.Count 『当前选中的单元格区域中的行数(54) Selection.Areas.Count 『选中的单元格区域所包含的区域数(55) edRange.Row 『获取单元格区域中使用的第一行的行号(56) Rng.Column 『获取单元格区域Rng左上角单元格所在列编号(57)ActiveSheet.Cells.SpecialCells(xlCellTypeAllFormatConditions) 『在活动工作表中返回所有符合条件格式设置的区域(58) Range(「A1」).AutoFilterField:=3,VisibleDropDown:=False 『关闭由于执行自动筛选命令产生的第3个字段的下拉列表名称(59) Range(「A1：C3」).Name=「computer」『命名A1：C3区域为computer 或Range(「D1：E6」).Name=「Sheet1!book」『命名局部变量，即Sheet1上区域D1：E6为book或Names(「computer」).Name=「robot」『将区域computer重命名为robot(60) Names(「book」).Delete 『删除名称(61) Names.Add Name:=「ContentList」，_RefersTo:=「=OFFSET(Sheet1!A2,0,0,COUNTA(Sheet2!$A:$A))」『动态命名列(62) Names.Add Name:=「Company」,RefersTo:=「CompanyCar」『命名字符串CompanyCar(63) Names.Add Name:=「Total」,RefersTo:=123456『将数字123456命名为Total。

100个vba例子程序基本代码这些 VBA 代码将帮助您快速执行一些您经常在电子表格中执行的基本任务1.添加序列号此宏代码将帮助您在Excel 工作表中自动添加序列号，如果您处理大数据，这对您很有帮助。

要使用此代码，您需要选择要从其中开始序列号的单元格，当您运行此代码时，它会显示一个消息框，您需要在其中输入序列号的最高编号，然后单击确定。

一旦您单击“确定”，它就会简单地运行一个循环并将序列号列表添加到向下的单元格中。

2.插入多列此代码可帮助您单击一次输入多个列。

当您运行此代码时，它会询问您要添加的列数，当您单击确定时，它会在所选单元格之后添加输入的列数。

如果要在所选单元格之前添加列，请将代码中的xlToRight 替换为 xlToLeft。

3.插入多行使用此代码，您可以在工作表中输入多行。

运行此代码时，您可以输入要插入的行数，并确保选择要插入新行的单元格。

如果要在所选单元格之前添加行，请将代码中的 xlT oDown 替换为 xlT oUp。

4. 自动调整列此代码可快速自动适应工作表中的所有列。

因此，当您运行此代码时，它将选择工作表中的所有单元格并立即自动调整所有列。

5. 自动调整行您可以使用此代码自动调整工作表中的所有行。

当您运行此代码时，它将选择工作表中的所有单元格并立即自动适应所有行。

6.删除文本换行此代码将帮助您通过单击从整个工作表中删除文本换行。

它将首先选择所有列，然后删除文本换行并自动适应所有行和列。

您还可以使用 (Alt + H +W) 的快捷方式，但如果将此代码添加到快速访问工具栏，它比键盘快捷方式更方便。

7. 取消合并单元格此代码仅使用 HOME 选项卡上的取消合并选项。

使用此代码的好处是您可以将其添加到 QAT 并取消合并选择中的所有单元格。

如果您想取消合并特定范围，您可以通过替换单词选择在代码中定义该范围。

8. 打开计算器在Windows 中，有一个特定的计算器，通过使用此宏代码，您可以直接从 Excel 打开该计算器。

AActivate 将指定的图面设成作用中。

Add 建立一个成员物件并将它加入适当的集成中。

Add3DFace 以给定的四个顶点建立一个3DFace物件。

Add3DMesh 以给定的M 与N 方向的点数以及点在M 与N 方向的座标值建立任意形式的3D网面。

Add3DPoly 依给定的座标值阵列建立3D聚合线。

AddArc 以给定的弧的中心点、半径、起始角度以及结束角度建立一个弧。

AddAttribute 以指定的性质在给定的位置建立属性定义。

AddBox 建立边缘和WCS 轴平行的3D实体方块。

AddCircle 以给定的中心点及半径建立一个圆。

AddCone 建立一个基底位於WCS 之XY 平面上的3D实体圆锥体。

AddCustomObject 建立Custom 物件。

AddCylinder 建立一个基底是在WCS 之XY 平面上的3D实体圆柱体。

AddDim3PointAngular 使用三点来建立角度标註。

AddDimAligned 建立一个对齐式标註物件。

AddDimAngular 建立弧、二条线或圆的角度标註。

AddDimDiametric 以给定的直径上的二点以及引线的长度建立圆或弧的直径标註。

AddDimOrdinate 以给定的定义点、及引线端点建立座标式标註。

AddDimRadial 在给定位置建立选取之物件的径向标註。

AddDimRotated 建立旋转的线性标註。

AddEllipse 以给定的中心点、主要轴上的一个点及半径比，在WCS 的XY 平面上建立一个椭圆。

AddEllipticalCone 以给定的Center、MajorRadius、MinorRadius 以及Height 在WCS 的XY 平面上建立一个3D实体椭圆圆锥体。

AddEllipticalCylinder 以给定的Center、MajorRadius、MinorRadius 以及Height 在WCS 的XY 平面上建立一个3D实体椭圆圆柱体。

Excel之VBA编程常用语句300句时间:2009-11-27 21:12:21 来源:本站作者:未知我要投稿我要收藏投稿指南定制模块行为(1) Option Explicit '强制对模块内所有变量进行声明Option Private Module '标记模块为私有，仅对同一工程中其它模块有用，在宏对话框中不显示Option Compare Text '字符串不区分大小写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 '关闭当前工作簿(12) ActiveWorkbook.Sheets.Count '获取活动工作薄中工作表数(13) '返回活动工作薄的名称(14) ‘返回当前工作簿名称ThisWorkbook.FullName ‘返回当前工作簿路径和名称(15) ActiveWindow.EnableResize=False ‘禁止调整活动工作簿的大小(16) Application.Window.Arrange xlArrangeStyleT iled ‘将工作簿以平铺方式排列(17) ActiveWorkbook.WindowState=xlMaximized ‘将当前工作簿最大化工作表(18) edRange.Rows.Count ‘当前工作表中已使用的行数(19) Rows.Count ‘获取工作表的行数(注：考虑向前兼容性)(20) Sheets(Sheet1).Name= “Sum” '将Sheet1命名为Sum(21) ThisWorkbook.Sheets.Add Before:=Worksheets(1) '添加一个新工作表在第一工作表前(22) ActiveSheet.Move After:=ActiveWorkbook. _Sheets(ActiveWorkbook.Sheets.Count) '将当前工作表移至工作表的最后(23) Worksheets(Array(“sheet1”,”sheet2”)).Select '同时选择工作表1和工作表2(24) Sheets(“sheet1”).Delete或 Sheets(1).Delete '删除工作表1(25) ActiveWorkbook.Sheets(i).Name '获取工作表i的名称(26) ActiveWindow.DisplayGridlines=Not ActiveWindow.DisplayGridlines '切换工作表中的网格线显示，这种方法也可以用在其它方面进行相互切换，即相当于开关按钮(27) ActiveWindow.DisplayHeadings=Not ActiveWindow.DisplayHeadings‘切换工作表中的行列边框显示(28) edRange.F ormatConditions.Delete ‘删除当前工作表中所有的条件格式(29) Cells.Hyperlinks.Delete ‘取消当前工作表所有超链接(30) ActiveSheet.PageSetup.Orientation=xlLandscape或ActiveSheet.PageSetup.Orientation=2 '将页面设置更改为横向(31) ActiveSheet.PageSetup.RightFooter=ActiveWorkbook.FullName ‘在页面设置的表尾中输入文件路径ActiveSheet.PageSetup.LeftFooter=erName ‘将用户名放置在活动工作表的页脚单元格/单元格区域(32) ActiveCell.CurrentRegion.Select或Range(ActiveCell.End(xlUp),ActiveCell.End(xlDown)).Select'选择当前活动单元格所包含的范围，上下左右无空行(33) Cells.Select ‘选定当前工作表的所有单元格(34) Range(“A1”).ClearContents '清除活动工作表上单元格A1中的内容Selection.ClearContents '清除选定区域内容Range(“A1:D4”).Clear '彻底清除A1至D4单元格区域的内容，包括格式(35) Cells.Clear '清除工作表中所有单元格的内容(36) ActiveCell.Offset(1,0).Select '活动单元格下移一行，同理，可下移一列(37) Range(“A1”).Offset(ColumnOffset:=1)或Range(“A1”).Offset(,1) ‘偏移一列Range(“A1”).Offset(Rowoffset:=-1)或Range(“A1”).Offset(-1) ‘向上偏移一行(38) Range(“A1”).Copy Range(“B1”) '复制单元格A1，粘贴到单元格B1中Range(“A1:D8”).Copy Range(“F1”) '将单元格区域复制到单元格F1开始的区域中Range(“A1:D8”).Cut Range(“F1”) '剪切单元格区域A1至D8，复制到单元格F1开始的区域中Ran ge(“A1”).CurrentRegion.Copy Sheets(“Sheet2”).Range(“A1”) '复制包含A1的单元格区域到工作表2中以A1起始的单元格区域中注：CurrentRegion属性等价于定位命令，由一个矩形单元格块组成，周围是一个或多个空行或列(39) ActiveWindow.RangeSelection.Value=XX '将值XX输入到所选单元格区域中(40) ActiveWindow.RangeSelection.Count '活动窗口中选择的单元格数(41) Selection.Count '当前选中区域的单元格数(42)GetAddress=Replace(Hyperlinkcell.Hyperlinks(1).Address,mailto:,””) ‘返回单元格中超级链接的地址并赋值(43) TextColor=Range(“A1”).Font.ColorIndex ‘检查单元格A1的文本颜色并返回颜色索引Range(“A1”).Interior.ColorIndex ‘获取单元格A1背景色(44) cells.count ‘返回当前工作表的单元格数(45) Selection.Range(“E4”).Select ‘激活当前活动单元格下方3行，向右4列的单元格(46) Cells.Item(5,”C”) ‘引单元格C5Cells.Item(5,3) ‘引单元格C5(47) Range(“A1”).Offset(RowOffset:=4,ColumnOffset:=5)或Range(“A1”).Offset(4,5) ‘指定单元格F5(48) Range(“B3”).Resize(RowSize:=11,ColumnSize:=3)R nage(“B3”).Resize(11,3) ‘创建B3：D13区域(49) Range(“Data”).Resize(,2) ‘将Data区域扩充2列(50) Union(Range(“Data1”),Range(“Data2”)) ‘将Data1和Data2区域连接(51) Intersect(Range(“Data1”),Range(“Data2”)) ‘返回Data1和Data2区域的交叉区域(52) Range(“Data”).Count ‘单元格区域Data中的单元格数Range(“Data”). Columns.Count ‘单元格区域Data中的列数Range(“Data”). Rows.Count ‘单元格区域Data中的行数(53) Selection.Columns.Count ‘当前选中的单元格区域中的列数Selection.Rows.Count ‘当前选中的单元格区域中的行数(54) Selection.Areas.Count ‘选中的单元格区域所包含的区域数(55) edRange.Row ‘获取单元格区域中使用的第一行的行号Excel之VBA编程常用语句300句时间:2009-11-27 21:12:21 来源:本站作者:未知我要投稿我要收藏投稿指南(56) Rng.Column ‘获取单元格区域Rng左上角单元格所在列编号(57) ActiveSheet.Cells.SpecialCells(xlCellTypeAllFormatConditions) ‘在活动工作表中返回所有符合条件格式设置的区域(58) Range(“A1”).AutoFilter Field:=3,VisibleDropDown:=False ‘关闭由于执行自动筛选命令产生的第3个字段的下拉列表名称(59) Range(“A1：C3”).Name=“computer” ‘命名A1：C3区域为computer 或Range(“D1：E6”).Name=“Sheet1!book” ‘命名局部变量，即Sheet1上区域D1：E6为book或Names(“computer”).Name=“robot” ‘将区域computer重命名为robot(60) Names(“book”).Delete ‘删除名称(61) Names.Add Name:=“ContentList”，_RefersTo:=“=OFFSET(Sheet1!A2,0,0,COUNTA(Sheet2!$A:$A))” ‘动态命名列(62) Names.Add Name:=“Company”,RefersTo:=“CompanyCar” ‘命名字符串CompanyCar(63) Names.Add Name:=“Total”,RefersTo:=123456 ‘将数字123456命名为Total。

VBA基础04--循环语句用心了自然而然的就通了，沉下心去看10分钟就知道效果了*************************************************************** ****Sub t1() '注意循环语句面向的是有序有规律，有限次数或有终止条件的Range('d2') = Range('b2') * Range('c2') '看看这些都是有规律可寻的，同一行单元格里 D2 = B2 C2 ，下面也是同样Range('d3') = Range('b3') * Range('c3') '一行行的处理起来，还不如使用公式来便捷，当然这些个例题都是用来说明 VBA 很强大Range('d4') = Range('b4') * Range('c4') '你说一个函数搞定，但是如果是数百的表要处理，你每次是不是都要输入一次函数，就算是复制粘贴想想也觉着累Range('d5') = Range('b5') * Range('c5') '使用 VBA 就可以了，点一下，全部搞定Range('d6') = Range('b6') * Range('c6')End Sub*************************************************************** ***上面那些，下面一个过程搞定了Sub t2()Dim x As Integer '定义一个整型变量 xFor x = 10000 To 2 Step -3 '初始化 x 的初始值为 10000 到终止值 2，一看就是降序的方式，步副是 -3Range('d' & x) = Range('b' & x) * Range('c' & x) '将上面过程中的一个行拿过来修改一下 OK，那个 & 是字符串拼接符，如：'b' & x 结果就是 bxNext xEnd Sub*************************************************************** ****针对第一个过程里的操作，第二种操作方式如下Sub t3()Dim rg As Range '这里不同以前看到的，它定义的是一个单元格区域类型For Each rg In Range('d2:d18') '这也是一个循环，这个循环使用的方式是在已有的数据中循环提取出来进行处理rg = rg.Offset(0, -1) * rg.Offset(0, -2) '同时，这里的不是用单元格的方式来运算，而是使用与当前格的绝对偏移来选取其它两个单元格Next rgEnd Sub*************************************************************** ****使用 do......loop Until 循环语句的方式处理Sub t4()Dim x As Integerx = 1 '这里给 x 一个初始值Dox = x 1 '将 x 值循环加1，直到 x 的值等于 18 才登上循环，Until 英文意思就是直到....时候，才怎么样Cells(x, 4) = Cells(x, 2) * Cells(x, 3) '这里使用 Cells（行数，列数）的方式来选择单元格Loop Until x = 18End Sub*************************************************************** ****使用 Do While......loop 循环的方式来实现Sub t5()x = 1 '给 x 一个初始值，这里没有使用 dim 进行定义也是可以的，就是 vba 的自由之处Do While x < 18 '当 x 的值小于 18 时，开始执行以下代码x = x 1 '每循环一次 x 1 一次，直接它不小于 18 时，While 的条件不满足时，就会停止循环Cells(x, 4) = Cells(x, 2) * Cells(x, 3)LoopEnd Sub====================================== =================================再看两个例子吧Sub s1()Dim rg As Range '定义一个区域类型，你懂的吧For Each rg In Range('a1:b7,d5:e9') '看这个有啥不同，不错，它可以有多个区域，但处理数据还是每次处理一个单元格If rg = '' Thenrg = 0End IfNext rgEnd Sub***********************************************************下面是将判断语句嵌套在循环中Sub s2()Dim x As Integer '注意这里定义了 x 是整型变量，但没有给初始值，整型数据初始值默认为 0Dox = x 1If Cells(x 1, 1) <> Cells(x, 1) 1 Then '假设 x=1, 判断 cells(2,1) <> cells(1,1) 1 是否正确或是否为真，如果成立Cells(x, 2) = '断点' '则将 Cells(1,2) 单元格的值填充“断点”Exit DoEnd IfLoop Until x = 14End Sub。