vba常用代码大全

excel vba常用代码Excel VBA是一种用于编写宏的编程语言，它可以帮助我们在Excel 中进行自动化操作。

在VBA中，有一些常用的代码，可以帮助我们快速完成一些常见的任务。

本文将介绍一些常用的Excel VBA代码，帮助读者更好地理解并运用它们。

一、数据处理1.1 数据筛选在Excel中，我们经常需要根据某些条件筛选数据。

使用VBA可以实现自动筛选，代码如下：```ActiveSheet.Range("A1:D10").AutoFilter Field:=1, Criteria1:=">10"```以上代码将自动筛选出范围为A1:D10的数据，其中第一列大于10的数据。

1.2 数据排序有时候，我们需要对数据进行排序。

使用VBA可以实现自动排序，代码如下：```ActiveSheet.Range("A1:D10").Sort Key1:=Range("A1"), Order1:=xlAscending```以上代码将自动对范围为A1:D10的数据根据第一列进行升序排序。

1.3 数据透视表数据透视表可以帮助我们对数据进行汇总和分析。

使用VBA可以自动生成数据透视表，代码如下：```ActiveSheet.PivotTableWizard```以上代码将自动生成一个数据透视表。

二、单元格操作2.1 单元格赋值在VBA中，我们可以使用代码将某个值赋给指定的单元格，代码如下：```Range("A1").Value = "Hello World"```以上代码将把"Hello World"赋值给A1单元格。

2.2 单元格格式设置使用VBA可以设置单元格的格式，例如设置字体、颜色、边框等，代码如下：```Range("A1").Font.Bold = TrueRange("A1").Interior.Color = RGB(255, 0, 0)Range("A1").Borders.LineStyle = xlContinuous```以上代码将设置A1单元格的字体为粗体、背景色为红色、边框为实线。

.、八、-刖言我们平时在工作表单元格的公式中常常使用函数，EGcel自带的常用的函数多达300多个, 功能强大，丰富多彩，但是在 VBA中不能直接应用，必须在函数名前面加上对象，比如：Applicatio n. WorksheetF un ctio n.Sum(arg1,arg2,arg3) 。

而能在VBA中直接应用的函数也有几十个，下面将逐一详细介绍常用的40个VBA函数, 以供大家学习参考。

第1.1例ASC函数一、题目：要求编写一段代码，运行后得到字符串”EGcel”的首字母和” e”的ASCII值。

二、代码：Sub 示例_1_01()DimmyNum1%,myNum2%myNum仁Asc("EGcel")'返回 69myNum2=Asc("e")' 返回 101[a1]="myNum 1=":[b1]=myNum1[a2]="myNum2=":[b2]=myNum2En dSub三、代码详解1、Sub示例_1_01():宏程序的开始语句。

2、DimmyNum1%,myNum2% :变量 myNum1 和 myNum2 声明为整型变量。

也可以写为DimmyNum1AsInteger 。

Integer变量存储为16位(2个字节)的数值形式，其范围为-32,768到32,767之间。

Integer的类型声明字符是百分比符号(％)。

3、myNum1=Asc("EGcel"):把 Asc 函数的值赋给变量 myNum1 。

Asc函数返回一个Integer，代表字符串中首字母的字符的 ASCII代码。

语法Asc(stri ng)必要的string (字符串)参数可以是任何有效的字符串表达式。

如果string中没有包含任何字符，则会产生运行时错误。

4、myNum2=Asc("e"):把Asc函数的值赋给变量myNum2。

VBA常用代码：Application.EnableEvents= True/ False ’启用/禁用所有事件Application.DisplayAlerts=True/False ’显示/关闭警告框提示框Application.ScreenUpdating= True/False ’显示/关闭屏幕刷新Application.StatusBar = "软件报专用" ’在地址栏中显示文本，标题栏用Caption属性Application.Cursor = xlIBeam ‘设置光标形状为Ⅰ字形，xlWait为沙漏(等待)形，xlNormal 为正常Application.WindowState = xlMinimized ‘窗口最小化，xlMaximized最大化，xlNormal为正常Application.ActivateMicrosoftApp xlMicrosoftWord ’开启Word应用程序Application.TemplatesPath ‘获取工作簿模板的位置Application.CalculateFull ’重新计算所有打开的工作簿中的数据Application.RecentFiles.Maximum = 2 ’将最近使用的文档列表数设为2Application.RecentFiles(3).Open ’打开最近打开的文档中的第3个文档Application.AutoCorrect.AddReplacement "sweek", "软件报" ’自动将输入的"sweek"更正为"软件报"Application.Dialogs(xlDialogPrint).Show ‘显示打印文档的对话框Application.OnTime Now + TimeValue("00:00:45"), "process" ’45分钟后执行指定过程Application.OnTime TimeValue("14:00:00"), " process " ’下午2点执行指定过程Application.OnTime EarliestTime:=TimeValue("14:00:00"), _Procedure:="process", Schedule:=False ’取消指定时间的过程的执行工作簿/工作表篇ActiveWorkbook.Sheets.Count ’获取活动工作薄中工作表数ActiveWorkbook.LinkSources(xlExcelLinks)(1) ‘返回当前工作簿中的第一条链接ThisWorkbook.Worksheets(“sheet2”).Visible=xlSheetHidden ‘隐藏工作表，与在Excel菜单中执行“格式—工作表—隐藏”操作一样ThisWorkbook.Worksheets(“sheet2”).Visible=xlSheetVeryHidden ‘隐藏工作表，不能通过在Excel菜单中执行“格式—工作表—取消隐藏”来重新显示工作表ThisWorkbook.Worksheets(“sheet2”).Visible=xlSheetVisible ‘显示被隐藏的工作表ThisWorkbook.Sheets(1).ProtectContents ‘检查工作表是否受到保护ActiveSheet.Columns("B").CutActiveSheet.Columns("F").Insert ‘以上两句将B列数据移至F列，原C列后的数据左移ActiveSheet.Range(“A:A”).EntireColumn.AutoFit ‘自动调整当前工作表A列的列宽ActiveSheet.Cells.SpecialCells(xlCellTypeConstants,xlTextValues) ‘选中当前工作表中常量和文本单元格ActiveSheet.Cells.SpecialCells(xlCellTypeConstants,xlErrors+xlTextValues) ‘选中当前工作表中常量和文本及错误值单元格edRange.Rows.Count ‘当前工作表中已使用的行数ThisWorkbook.Worksheets.Add ThisWorkbook.Worksheets(3), , 2 ‘在第3张工作表之前添加2个新的工作表ActiveSheet.Move After:=ActiveWorkbook. _Sheets(ActiveWorkbook.Sheets.Count) ’将当前工作表移至工作表的最后Worksheets(Array(“sheet1”,”sheet2”)).Select ’同时选择工作表sheet1和sheet2edRange.FormatConditions.Delete ‘删除当前工作表中应用的条件格式Cells.Hyperlinks.Delete ‘取消当前工作表中所有单元格的超链接ActiveSheet.PageSetup.RightFooter=ActiveWorkbook.FullName ‘在页脚显示文件的路径ActiveSheet.PrintPreview Enablechanges:=False ‘禁用显示在Excel的“打印预览”窗口中的“设置”和“页边距”按钮单元格/单元格区域篇edRange.Row ‘获取已使用的单元格区域的第一行的行号Range(“A65536”).End(xlUp).Row ‘返回A列最后一行(即记录的总条数)cell.Range(“A1”).HasFormula ‘检查单元格或单元格区域中的第一个单元格是否含有公式或cell.HasFormula ‘工作表中单元格是否含有公式Target.EntireColumn.Select ‘选择单元格所在的整个列，Target.EntireRow.Select为选择单元格所在的整行ActiveCell.Row ‘活动单元格所在的行号，ActiveCell.Column为活动单元格所在的列数ActiveWindow.ScrollRow = 2 ’将当前工作表窗口滚动到第2行ActiveWindow.ScrollColumn = 5 ’将当前工作表窗口滚动到第5列Worksheets("sheet1").Range("A1:C5").CopyPicture xlScreen, xlBitmap ’将指定的单元格区域的内容复制成屏幕快照Selection.Hyperlinks.Delete ‘删除所选区域的所有链接ActiveSheet.Cells(1, 1).Font.Bold = TRUE ‘Bold属性用于设置字体是否为加粗，Size属性设置字体大小，ColorIndex属性设置字体颜色（其值为颜色索引号），Italic属性设置字型是否为倾斜，Name属性设置字体名称ActiveSheet.Cells(1, 1).Interior.ColorIndex = 3 ‘将单元格的背景色设置为红色IsEmpty (ActiveCell.Value) ’判断活动单元格中是否有值ActiveCell.Value = UCase(ActiveCell.Value) ’将当前单元格中的字符转换成大写ActiveCell.Value = StrConv(ActiveCell.Value, vbLowerCase) ’将活动单元格中的字符串转换成小写ActiveCell.CurrentRegion.Select ’选择当前活动单元格所在的连续的非空区域，也可以用Range(ActiveCell, UsedRange.End(xlDown)).SelectActiveCell.Offset(1,0).Select ’活动单元格下移一行Range(“B2”).Offset(ColumnOffset:=1)或Range(“B2”).Offset(,1) ‘读取指定单元格右侧单元格中的数据Range(“B2”).Offset(Rowoffset:=-1)或Range(“B2”).Offset(-1) ‘读取指定单元格上一行单元格中的数据Range(“A1”).Copy Range(“B1”) ’复制单元格A1中的内容到B1中Range(“A1:D8”).Copy Range(“H1”) ’将指定单元格区域复制到从H1开始的区域中，用Cut方法可以实现剪切操作ActiveWindow.RangeSelection.Value = "软件报" ’将指定字符串输入到所选单元格区域中窗体（控件）篇Option Explicit ’强制对模块内所有变量进行声明Userform1.Show ‘显示用户窗体Load Userform1 ‘加载一个用户窗体,但该窗体处于隐藏状态Userform1.Hide ‘隐藏用户窗体Unload Userform1 或Unload Me ‘卸载用户窗体Me.Height=Int(0.5 * ActiveWindow.Height) ‘窗体高度为当前活动窗口高度的一半，宽度用ActiveWindow. Width属性boBox1.AddItem Sheets("Sheet1").Cells(1, 1) ‘将指定单元格中的数据添加到复合框中ListBox1.List=MyProduct() ‘将数组MyProduct的值添加到列表框ListBox1中ListBox1.RowSource=”Sheet1!isum”‘将工作表Sheet1中名为的isum区域的值添加到列表框中ListBox1.Selected(0) ‘选中列表框中的指定的条目ListBox1.RemoveItem ListBox1.ListIndex ‘移除列表框中选中的条目If MsgBox(“要退出吗？”,vbYesNo)<>vbYes Then Exit Sub ’返回值不为“是”，则退出Config=vbYesNo+vbQuestion+vbDefaultButton2 ’使用常量的组合，赋值组Config变量，并设置第二个按钮为缺省按钮MsgBox “This is the first line.”& vbNewLine & “Second line.”’在消息框中强制换行，也可用vbCrLf代替vbNewLine。

常⽤VBA代码VBA代码（珍藏）'**关闭屏幕刷新Application.ScreenUpdating = False'**取消删除⼯作表警告提⽰Application.DisplayAlerts = False'**引⽤打开窗⼝Dim fd As FileDialogDim vrtSelectedItem As VariantSet fd = Application.FileDialog(msoFileDialogOpen)fd.InitialFileName = Sheets('设置').Range('CU7').Value & '\库存核对' '默认打开的⽂件夹 With fd.AllowMultiSelect = True '可选多个⽂件If .Show = -1 ThenFor Each vrtSelectedItem In .SelectedItemsFJ = Split(vrtSelectedItem, '\')ThisWorkbook.Sheets('设置').Range(CR).Value = FJ(3) '记录⽂件名ThisWorkbook.Sheets('设置').Range('AG1').Value = FJ(3) '记录⽂件名fd.Execute '执⾏打开mandButton62.Enabled = TrueExit ForNextEnd IfEnd WithSet fd = Nothing****得到计算机名称Environ('Computername')****判断是不是数字If IsNumeric(InputBox('Please Input:')) Then****筛选⾮空单元格ActiveSheet.Range('$E$7:$I$15').AutoFilter Field:=1, Criteria1:='<>'****仅贴值Range('F5:J25').SelectSelection.CopyRange('E5').SelectActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _IconFileName:=False****设置是否冻结空格ActiveWindow.FreezePanes = FalseActiveWindow.FreezePanes = True****设置页⾯With ActiveSheet.PageSetup.LeftFooter = '编制：审核：' '页脚LEFT.PrintTitleRows = '$1:$3' '要打印的默认页头.PrintArea = '$A$1:$E$12' '打印区域End With.PrintOut Copies:=2 '打印(2份)****设置批注Range('F8').AddComment'添加批注Range('F8').Comment.Visible = False'隐藏框.Comment.Shape.TextFrame.AutoSize = True'⾃动调整框⼤⼩.Comment.Font.FontStyle = '常规' '将字体设置为“常规”（不加粗）(不成功) '-------------------------------------Range('F8').Comment.Text Text:='黄传兵:' & Chr(10) & 'SS'If Range('F8').Comment Is Nothing Then '如果没有批注内容Public Function OPEN_JL(WJ As String) '检测是否有相应引⽤⽂件的打开记录 Dim I As IntegerDim MC, MC_CR As StringL3 = ThisWorkbook.Sheets('设置').Range('N2').ValueFor I = 4 To L3 + 3MC_CR = 'N' & IMC = ThisWorkbook.Sheets('设置').Range(MC_CR).ValueIf UCase(MC) = UCase(WJ) ThenOPEN_JL = 'Y'Exit ForEnd IfNext IEnd Function'打开需引⽤的⽂件Public Sub OPEN_WJ(LJ, WJ As String)On Error GoTo X:Dim M4, Y3 As StringDim LJWJ As StringLJWJ = LJ & WJIf OPEN_YN(WJ) <> 'Y' Then '如果未被其它引⽤并打开Workbooks.Open Filename:=LJWJL3 = ThisWorkbook.Sheets('设置').Range('N2').ValueM3_CR = 'N' & L3 + 4M4_CR = 'O' & L3 + 4ThisWorkbook.Sheets('设置').Range(M3_CR).Value = WJThisWorkbook.Sheets('设置').Range(M4_CR).Value = 1Windows(WJ).Visible = FalseElse '如果已被其它引⽤并打开If OPEN_JL(WJ) = '' ThenL3 = ThisWorkbook.Sheets('设置').Range('N2').ValueM3_CR = 'N' & L3 + 4M4_CR = 'O' & L3 + 4ThisWorkbook.Sheets('设置').Range(M3_CR).Value = WJThisWorkbook.Sheets('设置').Range(M4_CR).Value = 2End IfEnd IfExit SubX:MsgBox ''' & WJ & ''未打开，请检查路径。

在VBA中，你可以使用宏来自动执行一系列的操作。

以下是一些常用的VBA宏代码示例：1.打开一个工作簿：vba复制代码Sub OpenWorkbook()Workbooks.Open "C:\path\to\your\workbook.xlsx"End Sub2.关闭一个工作簿：vba复制代码Sub CloseWorkbook()ThisWorkbook.Close SaveChanges:=TrueEnd Sub3.复制一个单元格的内容：vba复制代码Sub CopyCell()Range("A1").Copy Range("B1")End Sub4.粘贴一个单元格的内容：vba复制代码Sub PasteCell()Range("B1").PasteSpecial Paste:=xlPasteValuesEnd Sub5.查找并替换单元格中的内容：vba复制代码Sub FindAndReplace()Range("A1").Replace What:="old", Replacement:="new"End Sub6.自动填充数据：vba复制代码Sub AutoFill()Range("A1:A10").FillDownEnd Sub7.插入新的列或行：vba复制代码Sub InsertColumn()Columns("B:B").Insert Shift:=xlToRight,CopyOrigin:=xlFormatFromLeftOrAboveEnd Sub8.删除列或行：vba复制代码Sub DeleteColumn()Columns("B:B").Delete Shift:=xlToLeft,CopyOrigin:=xlFormatFromLeftOrAboveEnd Sub。

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编程代码大全VBA编程代码大全。

VBA（Visual Basic for Applications）是一种用于应用程序开发的编程语言，它可以帮助用户在Microsoft Office软件中自动化任务，提高工作效率。

在本文中，我们将为您介绍一些常用的VBA编程代码，帮助您更好地利用VBA来处理各种任务。

首先，让我们来看一些常用的VBA基础操作代码。

在VBA中，您可以使用MsgBox函数来显示消息框，例如：```vba。

MsgBox "Hello, World!"```。

这段代码将会在屏幕上显示一个包含"Hello, World!"的消息框。

除了MsgBox 函数，VBA还提供了InputBox函数来获取用户输入的数值或文本：```vba。

Dim userInput As String。

userInput = InputBox("Please enter your name:")。

```。

这段代码将会弹出一个输入框，等待用户输入姓名，并将用户输入的内容存储在userInput变量中。

接下来，让我们来看一些与Excel相关的VBA代码。

在Excel中，VBA可以帮助您自动化各种数据处理任务。

例如，您可以使用VBA来创建新的工作表，并向其中填充数据：```vba。

Dim ws As Worksheet。

Set ws = ThisWorkbook.Sheets.Add。

= "NewSheet"ws.Range("A1").Value = "Hello"```。

这段代码将会在当前工作簿中创建一个名为"NewSheet"的新工作表，并在A1单元格中填入"Hello"。

除了操作工作表，VBA还可以帮助您处理Excel中的图表。

例如，您可以使用VBA来创建新的图表，并向其中添加数据：```vba。

目录一、引用 (2)二、Worksheet_Change事件： (2)三、相乘 (4)四、相减 (5)五、高级筛选 (5)六、双击事件 (7)七．单位汇总（sumif），单条件汇总 (9)八、多条件汇总（连接、sumif） (11)九、多条件汇总、ado (13)十、对账 (15)十一、sql筛选 (18)十二、sql连接、交叉汇总 (20)十三、select语句总结 (22)十四、报表(有层次) (23)一、引用相对引用B4绝对引用$B$4混合引用＄B4、B＄4F4进行引用切换,$在字母前面则锁定列，在数字前面则锁定行。

二、Worksheet_Change 事件：1.在单元格中C4=VLOOKUP（B4，简码表!＄B＄4：$C＄1000，2，FALSE)2。

Worksheet_Change事件代码：Private Sub Worksheet_Change（ByVal Target As Range）On error resume nextIf Target.Row > 3 And Target。

Column = 2 Theni = Target.RowCells(i， 3） = Application.WorksheetFunction.VLookup(Cells（i, 2), Sheets(”简码表”）.Range（"b4:c100"）, 2, False)End IfEnd Sub备查代码：Private Sub Worksheet_Change(ByVal Target As Range）On Error Resume NextIf Target。

Row > 3 And Target。

Column = 5 Theni = Target.RowCells(i, 6） = Application.WorksheetFunction。

VLookup(Cells（i， 5）， Sheets(”类款项")。

前言我们平时在工作表单元格的公式中常常使用函数，Excel自带的常用的函数多达300多个，功能强大，丰富多彩，但是在VBA中不能直接应用，必须在函数名前面加上对象，比如：Application.WorksheetFunction.Sum(arg1,arg2,arg3)。

而能在VBA中直接应用的函数也有几十个，下面将逐一详细介绍常用的40个VBA 函数，以供大家学习参考。

第1.1例 ASC函数一、题目：要求编写一段代码，运行后得到字符串”Excel”的首字母和”e”的ASCII 值。

二、代码：Sub 示例_1_01()Dim myNum1%, myNum2%myNum1 = Asc("Excel") '返回69myNum2 = Asc("e") '返回101[a1] = "myNum1= ": [b1] = myNum1[a2] = "myNum2= ": [b2] = myNum2End Sub三、代码详解1、Sub 示例_1_01()：宏程序的开始语句。

2、Dim myNum1%, myNum2%：变量myNum1和myNum2声明为整型变量。

也可以写为 Dim myNum1 As Integer 。

Integer 变量存储为 16位（2 个字节）的数值形式，其范围为 -32,768 到 32,767 之间。

Integer 的类型声明字符是百分比符号 (%)。

3、myNum1 = Asc("Excel")：把Asc函数的值赋给变量myNum1。

Asc函数返回一个 Integer，代表字符串中首字母的字符的ASCII代码。

语法Asc(string)必要的 string（字符串）参数可以是任何有效的字符串表达式。

如果 string 中没有包含任何字符，则会产生运行时错误。

4、myNum2 = Asc("e")：把Asc函数的值赋给变量myNum2。

EXCEL/WPS VBA宏代码大全Application.Dialogs(1).Show是调用打开对话框Application.Dialogs(5或145).Show是调用另存为对话框，Application.Dialogs(6).Show是删除文档Application.Dialogs(7).Show是页面设置Application.Dialogs(8).Show是打印对话框Application.Dialogs(9).Show是选择打印机对话框Application.Dialogs(12).Show是重排窗口设置对话框Application.Dialogs(17).Show宏对话框Application.Dialogs(23).Show设置打印标题Application.Dialogs(26).Show字体设置对话框Application.Dialogs(27).Show显示选项Application.Dialogs(28).Show保护工作表Application.Dialogs(32).Show重算选项Application.Dialogs(39或192).Show排序Application.Dialogs(40).Show序列选项Application.Dialogs(41).Show模拟运算表Application.Dialogs(42或111).Show单元格格式，选择单元格内容的格式Application.Dialogs(43).Show选择单元格字体的排列格式，横排或竖排等Application.Dialogs(44或134或190).Show字体选择Application.Dialogs(45).Show边框格式设置Application.Dialogs(46).Show对单元格的保护或隐藏选项Application.Dialogs(47).Show列宽设置选项Application.Dialogs(52).Show清除对话框Application.Dialogs(53).Show选择性粘贴对话框Application.Dialogs(54).Show删除对话框Application.Dialogs(55).Show插入对话框Application.Dialogs(61或110).Show定义名称对话框Application.Dialogs(62).Show指定名称Application.Dialogs(63或132).Show定位Application.Dialogs(64).Show查找Application.Dialogs(84).Show设置单元格颜色和图案Application.Dialogs(91).Show分列Application.Dialogs(94).Show取消或隐藏工作表选择对话框Application.Dialogs(95).Show工作区视图等选项Application.Dialogs(103).Show选择要激活哪个工作表对话框Application.Dialogs(108).Show复制图片选项Application.Dialogs(119).Show新建对话框Application.Dialogs(127).Show设置行高Application.Dialogs(130).Show替换对话框Application.Dialogs(137).Show拆分当前窗口Application.Dialogs(161).Show设置图表颜色Application.Dialogs(170或171).Show移动当前窗口Application.Dialogs(191).Show合并计算对话框Application.Dialogs(198).Show单变量求解Application.Dialogs(199).Show选定成组工作表Application.Dialogs(200).Show填充成组工作表。

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 打开该计算器。

1、打开显示登录窗体代码打开隐藏表格，显示登录窗体private Sub Workbook_open()Application.Visible = falseUserForm1.Showend Sub2、固定账号、密码登录窗体设置（1）制作窗体（2）登录验证Private Sub CommandButton1_Click() If TextBox1 = "admin" ThenIf TextBox2 <> 123 ThenMsgBox "密码错误"Exit SubElseMsgBox "登录成功”"Unload MeApplication.Visible = TrueSheet1.ActivateEnd IfElseMsgBox "账号不存在"End IfEnd Sub（3）退出按钮Private Sub CommandButton2_Click() Unload MeThisWorkbook.CloseEnd Sub(4)打开注册窗体Private Sub CommandButton3_Click() UserForm2.ShowEnd Sub（5）唯一关闭代码Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) If CloseMode <> 1 Then Cancel = TrueEnd Sub3、注册账号（1）制作注册账号窗体（2）注册代码Private Sub CommandButton1_Click()Dim zh As Range, zt As RangeIf TextBox1 = "" Then MsgBox "未填入账户": Exit SubIf TextBox2 <> TextBox3 Then MsgBox "密码不一致": Exit SubSet zh = Sheets("注册").Range("a:a").Find(TextBox1.Text, , , 1)If zh Is Nothing ThenSet zt = Sheets("注册").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) zt = TextBox1.Textzt.Offset(0, 1) = TextBox2.Textzt.Offset(0, 2) = NowMsgBox "注册成功"Unload MeElseMsgBox "账号已经存在，请更换其他账号"End IfEnd Sub4、查找筛选代码Private Sub TextBox1_Change()If Len(TextBox1.Value) = 0 ThenSheet1.AutoFilterMode = FalseElseIf Sheet1.AutoFilterMode = True ThenSheet1.AutoFilterMode = FalseEnd IfSheet1.Range("B7:P" & Rows.Count).AutoFilter _field:=4, Criteria1:="*" & TextBox1.Value & "*"End IfEnd Sub5、多账号密码验证代码Private Sub CommandButton1_Click()If Len(TextBox1) = 0 Then MsgBox "未输入账号": Exit SubDim zh As RangeSet zh = Sheets("注册").Range("a:a").Find(TextBox1.Text, , , 1) If Not zh Is Nothing ThenIf TextBox2.Text <> zh.Offset(0, 1) ThenMsgBox "密码错误"Exit SubElseMsgBox "登录成功"Unload MeApplication.Visible = TrueSheet1.ActivateEnd IfElseMsgBox "账号不存在"End IfEnd Sub6、默认打开第一个工作表Private Sub Workbook_Open()Sheet1.ActivateEnd Sub7、退出保存工作表Private Sub Workbook_BeforeClose(Cancel As Boolean) ThisWorkbook.SaveEnd Sub。

1：打开所有隐藏工作表Sub打开所有隐藏工作表()Dim i As IntegerFor i=1To Sheets.CountSheets(i).Visible=TrueNext iEnd Sub2：循环宏Sub循环()AAA=Range("C2")Dim i As LongDim times As Longtimes=AAA'times代表循环次数，执行前把times赋值即可(不可小于1，不可大于2147483647)For i=1To timesCall过滤一行If Range("完成标志")="完成"ThenExit For'假如名为'完成标志'的命名单元的值等于'完成',则退出循环,假如一开始就等于'完成',则只执行一次循环就退出'If Sheets("传送参数").Range("A"&i).Text="完成"ThenExit For'假如某列出现"完成"内容则退出循环Next iEnd Sub3：录制宏时调用“停止录制”工具栏Sub录制宏时调用停止录制工具栏()mandBars("Stop Recording").Visible=TrueEnd Sub4：高级筛选5列不重复数据至指定表Sub高级筛选5列不重复数据至Sheet2()Sheets("Sheet2").Range("A1:E65536")=""'清除Sheet2的A:D列Range("A1:E65536").AdvancedFilter Action:=xlFilterCopy,CopyToRange:=Sheet2.Range(_"A1"),Unique:=TrueSheet2.Columns("A:E").Sort Key1:=Sheet2.Range("A2"),Order1:=xlAscending,Header:=xlGuess,_OrderCustom:=1,MatchCase:=False,Orientation:=xlTopToBottom,SortMethod_ :=xlPinYinEnd Sub5：双击单元执行宏(工作表代码)Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range,Cancel As Boolean)If Range("$A$1")="关闭"ThenExit SubSelect Case Target.AddressCase"$A$4"Call宏1Cancel=TrueCase"$B$4"Call宏2Cancel=TrueCase"$C$4"Call宏3Cancel=TrueCase"$E$4"Call宏4Cancel=TrueEnd SelectEnd Sub6：双击指定区域单元执行宏(工作表代码)Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range,Cancel As Boolean) If Range("$A$1")="关闭"Then Exit SubIf Not Application.Intersect(Target,Range("A4:A9","C4:C9"))Is Nothing Then Call打开隐藏表End Sub7：进入单元执行宏(工作表代码)Private Sub Worksheet_SelectionChange(ByVal Target As Range)'以单元格进入代替按钮对象调用宏If Range("$A$1")="关闭"Then Exit SubSelect Case Target.AddressCase"$A$5"'单元地址(Target.Address),或命名单元名字()Call宏1Case"$B$5"Call宏2Case"$C$5"Call宏3End SelectEnd Sub8：进入指定区域单元执行宏(工作表代码)Private Sub Worksheet_SelectionChange(ByVal Target As Range)If Range("$A$1")="关闭"Then Exit SubIf Not Application.Intersect(Target,Range("A4:A9","C4:C9"))Is Nothing Then Call打开隐藏表End Sub9：在多个宏中依次循环执行一个（控件按钮代码）Private Sub CommandButton1_Click()Static RunMacro As IntegerSelect Case RunMacroCase0宏1RunMacro=1Case1宏2RunMacro=2Case2宏3RunMacro=0End SelectEnd Sub10：在两个宏中依次循环执行一个并相应修改按钮名称（控件按钮代码）Private Sub CommandButton1_Click()With CommandButton1If.Caption="保护工作表"ThenCall保护工作表.Caption="取消工作表保护"Exit SubEnd IfIf.Caption="取消工作表保护"ThenCall取消工作表保护.Caption="保护工作表"Exit SubEnd IfEnd WithEnd Sub11：在三个宏中依次循环执行一个并相应修改按钮名称（控件按钮代码）Option Explicit Private Sub CommandButton1_Click()With CommandButton1If.Caption="宏1"ThenCall宏1.Caption="宏2"Exit SubEnd IfIf.Caption="宏2"ThenCall宏2.Caption="宏3"Exit SubEnd IfIf.Caption="宏3"ThenCall宏3.Caption="宏1"Exit SubEnd IfEnd WithEnd Sub12：根据A1单元文本隐藏/显示按钮（控件按钮代码）Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Range("A1")>2ThenCommandButton1.Visible=1ElseCommandButton1.Visible=0End IfEnd SubPrivate Sub CommandButton1_Click()重排窗口End Sub13：当前单元返回按钮名称（控件按钮代码）Private Sub CommandButton1_Click()ActiveCell=CommandButton1.CaptionEnd Sub14：当前单元内容返回到按钮名称（控件按钮代码）Private Sub CommandButton1_Click()CommandButton1.Caption=ActiveCellEnd Sub15：奇偶页分别打印Sub奇偶页分别打印()Dim i%,Ps%Ps=ExecuteExcel4Macro("GET.DOCUMENT(50)")'总页数MsgBox"现在打印奇数页,按确定开始."For i=1To Ps Step2ActiveSheet.PrintOut from:=i,To:=iNext iMsgBox"现在打印偶数页,按确定开始."For i=2To Ps Step2ActiveSheet.PrintOut from:=i,To:=iNext iEnd Sub16：自动打印多工作表第一页Sub自动打印多工作表第一页()Dim sh As IntegerDim xDim yDim syDim syzx=InputBox("请输入起始工作表名字:")sy=InputBox("请输入结束工作表名字:")y=Sheets(x).Indexsyz=Sheets(sy).IndexFor sh=y To syzSheets(sh).SelectSheets(sh).PrintOut from:=1,To:=1Next shEnd Sub17：查找A列文本循环插入分页符Sub循环插入分页符()'Selection=Workbooks("临时表").Sheets("表2").Range("A1")调用指定地址内容Dim i As LongDim times As Longtimes=Application.WorksheetFunction.CountIf(Sheet1.Range("a:a"),"分页")'times代表循环次数，执行前把times赋值即可(不可小于1，不可大于2147483647)For i=1To timesCall插入分页符Next iEnd SubSub插入分页符()Cells.Find(What:="分页",After:=ActiveCell,LookIn:=xlValues,LookAt:=_xlPart,SearchOrder:=xlByRows,SearchDirection:=xlNext,MatchCase:=False)_.ActivateActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCellEnd SubSub取消原分页()Cells.SelectActiveSheet.ResetAllPageBreaksEnd Sub18：将A列最后数据行以上的所有B列图片大小调整为所在单元大小Sub将A列最后数据行以上的所有B列图片大小调整为所在单元大小()Dim Pic As Picture,i&i=[A65536].End(xlUp).RowFor Each Pic In Sheet1.PicturesIf Not Application.Intersect(Pic.TopLeftCell,Range("B1:B"&i))Is Nothing Then Pic.Top=Pic.TopLeftCell.TopPic.Left=Pic.TopLeftCell.LeftPic.Height=Pic.TopLeftCell.HeightPic.Width=Pic.TopLeftCell.WidthEnd IfNextEnd Sub19：返回光标所在行数Sub返回光标所在行数()x=ActiveCell.RowRange("A1")=xEnd Sub20：在A1返回当前选中单元格数量Sub在A1返回当前选中单元格数量()[A1]=Selection.CountEnd Sub21：返回当前工作簿中工作表数量Sub返回当前工作簿中工作表数量()t=Application.Sheets.CountMsgBox tEnd Sub93：B列录入数据时在A列返回记录时间（工作表代码）Public Sub Worksheet_Change(ByVal Target As Range)If Target.Column=2ThenTarget.Offset(,-1)=NowEnd IfEnd Sub94：当指定区域修改时在其右侧的2个单元返回当前日期和时间（工作表代码）Public Sub Worksheet_Change(ByVal Target As Range)If Not Application.Intersect(Target,[A1:A1000])Is Nothing Then If Target.Column=1ThenTarget.Offset(,1)=DateTarget.Offset(,2)=TimeEnd IfEnd IfEnd SubPublic Sub Worksheet_Change(ByVal Target As Range)If Not Application.Intersect(Target,[A1:A1000])Is Nothing Then If Target.Column=1ThenTarget.Offset(,1)=Format(Now(),"yyyy-mm-dd")Target.Offset(,2)=Format(Now(),"h:mm:ss")End IfEnd IfEnd Sub95：指定单元显示光标位置内容（工作表代码）Private Sub Worksheet_SelectionChange(ByVal T As Range) Sheets(1).Range("A1")=SelectionEnd Sub96：每编辑一个单元保存文件Private Sub Worksheet_Change(ByVal Target As Range) ThisWorkbook.SaveEnd Sub97：指定允许编辑区域Sub指定允许编辑区域()ActiveSheet.ScrollArea="B8:G15"End Sub98：解除允许编辑区域限制Sub解除允许编辑区域限制()ActiveSheet.ScrollArea=""End Sub99：删除指定行Sub删除指定行()Workbooks("临时表").Sheets("表2").Range("5:5").Delete End Sub100：删除A列为指定内容的行Sub删除A列为指定内容的行()Dim a,b As Integera=Sheet1.[a65536].End(xlUp).RowFor b=a To2Step-1If Cells(b,1).Value="删除"ThenRows(b).DeleteEnd IfNextEnd SubExcel VBA常用代码总结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]•选中某sheetSet NewSheet = Sheets("sheet1")NewSheet.Select•选中或激活某单元格'“Range”对象的的Select方法可以选择一个或多个单元格，而Activate方法可以指定某一个单元格为活动单元格。

vba经典代码以下是一些经典的VBA代码示例：1. 在单元格中显示当前日期：```vbaRange("A1"Value = Date```2. 在单元格中显示当前时间：```vbaRange("A1"Value = Time```3. 在单元格中显示当前日期和时间：```vbaRange("A1"Value = Now```4. 循环遍历并处理所有工作表：```vbaDim ws As WorksheetFor Each ws In Worksheets"在此处添加处理代码Next ws```5. 将工作表中的数据复制到另一个工作表：```vbaWorksheets("Sheet1"UsedRange.CopyDestination:=Worksheets("Sheet2"Range("A1"```6. 打开文件对话框并选择文件路径：```vbaDim filePath As VariantfilePath = Application.GetOpenFilename("Excel 文件(*.xlsx),*.xlsx"If filePath <> False Then"在此处添加处理已选择文件的代码End If```7. 创建新工作簿并保存：```vbaDim newWorkbook As WorkbookSet newWorkbook = Workbooks.AddnewWorkbook.SaveAs "C:""路径""文件名.xlsx"```8. 删除所有空行：```vbaDim lastRow As LonglastRow = Cells(Rows.Count, 1).End(xlUp).RowOn Error Resume NextActiveSheet.Range("A1:A" &lastRow).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp On Error GoTo 0```9. 过滤数据并复制到另一个工作表：```vbaActiveSheet.Range("A1:D10"AutoFilter Field:=1,Criteria1:="条件"ActiveSheet.Range("A2:D10"SpecialCells(xlCellTypeVisible). CopyDestination:=Worksheets("Sheet2"Range("A1"ActiveSheet.AutoF ilterMode = False```10. 遍历并选择某一列中的所有唯一值：```vbaDim uniqueValues As CollectionSet uniqueValues = New CollectionDim cellValue As VariantOn Error Resume NextFor Each cellValue In Range("A1:A10" uniqueValues.Add cellValue, CStr(cellValue)Next cellValueOn Error GoTo 0```。

1.遍历所有已打开的word文档For Each docOpened In Documents……Next docOpened2.Word 将目录下所有文档转换为txt，并删除原文档Sub 目录下doc转txt()'目录下所有word文档转为txt，并删除word文档'保存在原目录'遍历所有文件夹，把带路径的文件名存入字典On Error Resume NextDim Path As String, t 'Path为路径,t用于计算程序执行花费的时间Set objshell = CreateObject("Shell.Application")Set objfolder = objshell.BrowseForFolder(0, "选择文件夹", 0, 0)If Not objfolder Is Nothing Then Path = objfolder.sel f.Path & "\"Set objfolder = NothingSet objshell = Nothing'创建字典用于存储路径和文件名Dim DicPath, DicFile, i As Integer, Ke, ContentName A s String, FileName As String, MsgTxtSet DicPath = CreateObject("Scripting.Dictionary")Set DicFile = CreateObject("Scripting.Dictionary")DicPath.Add Path, ""i = 0'存所有路径Do While i < DicPath.countKe = DicPath.keysContentName = Dir(Ke(i), vbDirectory)Do While ContentName <> ""'若有子文件夹，则添加'跳过当前的目录及上层目录If ContentName <> "." And ContentName < > ".." ThenIf GetAttr(Ke(i) & ContentName) = vbDirectory ThenDicPath.Add (Ke(i) & Conte ntName & "\"), ""End IfEnd IfContentName = DirLoopi = i + 1Loop'存所有doc文件名For Each Ke In DicPath.keysFileName = Dir(Ke & "*.doc")Do While FileName <> ""DicFile.Add (Ke & FileName), ""FileName = DirLoopNext Ke'打开文件Application.DisplayAlerts = wdAlertsNoneDim myDocFor Each Ke In DicFile.keysSet myDoc = Documents.Open(Ke)'原路径另存为TXTActiveDocument.SaveAs2 FileName:=myDoc.Path & "\" & Left(, InStrRev(, ".") - 1) & ".txt", FileFormat:=wdFormatText'处理完成后关闭并删除原word文档ActiveDocument.CloseKill KeNext KeMsgBox "Done！"End Sub3.获取网页源代码Dim httpRequest As ObjectSet httpRequest = CreateObject("MSXML2.XMLHTTP.3.0")httpRequest.Open "GET", "/tmp/auto product/ccq2/ci/cha_num.php?pid=" & ItemID & "&sdate=" & sDate & "&edate=" & eDate, FalsehttpRequest.SendtxtTemp = httpRequest.responseText或txtTemp = StrConv(httpRequest.responsebody, vbUnicode)4.Excel合并相同文件名的单元格，不同文件名的行填充不同的背景色Dim i As Integer, j As Integer, k As Integer 'i用于遍历，j 用于计数须合并的行数,k用于填充颜色i = 1k = 0With wbTmpDo While .Cells(i + 1, 1) <> ""j = 1Do While .Cells(i, 1) = .Cells(i + j, 1)j = j + 1LoopIf j > 1 Then.Range(.Cells(i, 1), .Cells(i + j - 1, 1)).MergeEnd IfIf (k Mod 2 = 1) Then.Cells(i, 1).Resize(j, 5).Interior.Color = 5296274Else: .Cells(i, 1).Resize(j, 5).Interior.Color = 49407End Ifk = k + 1i = i + jLoopEnd With5.若同目录下不存在某文件夹，则创建Dim srsr = Dir(ThisWorkbook.Path & "\上海办待导入txt", vbDirectory)If sr = "" ThenMkDir ThisWorkbook.Path & "\上海办待导入txt"End If6.Word替换昨日今日去年之类的字眼Sub 替换昨今去()Dim Yesterday_Day As Integer, Yesterday As String, Yesterday_M onth As Integer, Yesterday_Year As IntegerDim Today_Day As Integer, Today_Month As Integer, Today_Year As IntegerYesterday = DateAdd("d", -1, Date)Yesterday_Day = Day(Yesterday)Yesterday_Month = Month(Yesterday)Yesterday_Year = Year(Yesterday)Today_Day = Day(Date)Today_Month = Month(Date)Today_Year = Year(Date)'选择性粘贴Selection.PasteAndFormat (wdPasteDefault)Selection.Find.ClearFormattingSelection.Find.Replacement.ClearFormatting'取消所有超链接Dim cc As FieldFor Each cc In ActiveDocument.FieldsIf cc.Type = wdFieldHyperlink Thencc.UnlinkEnd IfNextSet cc = Nothing'替换昨天、昨日With Selection.Find.Text = "昨[天日]{1}".Replacement.Text = Yesterday_Month & "月" & Yesterday_Day & "日".Forward = True.Wrap = wdFindContinue.MatchByte = False.MatchWildcards = TrueEnd WithSelection.Find.Execute Replace:=wdReplaceAll'替换今天、今日With Selection.Find.Text = "今[天日]{1}".Replacement.Text = Today_Month & "月" & Today_Day & "日".Forward = True.Wrap = wdFindContinue.MatchByte = False.MatchWildcards = TrueEnd WithSelection.Find.Execute Replace:=wdReplaceAll'替换今年With Selection.Find.Text = "今年".Replacement.Text = Today_Year & "年".Forward = True.Wrap = wdFindContinue.MatchByte = False.MatchWildcards = TrueEnd WithSelection.Find.Execute Replace:=wdReplaceAll'替换去年With Selection.Find.Text = "去年".Replacement.Text = Today_Year - 1 & "年".Forward = True.Wrap = wdFindContinue.MatchByte = False.MatchWildcards = TrueEnd WithSelection.Find.Execute Replace:=wdReplaceAll'删象屿期货的段前符号With Selection.Find.Text = ChrW(61548).Replacement.Text = "".Forward = True.Wrap = wdFindContinue.MatchByte = True.MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAll'手动换行符替换成回车符With Selection.Find.Text = "^l".Replacement.Text = "^p".Forward = True.Wrap = wdFindContinue.MatchByte = True.MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAll'段与段顶多只隔一行，将任意个回车符号替换成二个With Selection.Find.Text = "(^13)@".Replacement.Text = "^p^p".Forward = True.Wrap = wdFindContinue.MatchByte = False.MatchWildcards = TrueEnd WithSelection.Find.Execute Replace:=wdReplaceAll'全选+剪切Selection.WholeStorySelection.CutEnd Sub7.提取word文档里的图片Sub 存成html()Application.ScreenUpdating = FalseDim FileName As StringFileName = InputBox("请输入文件名")Selection.CopyDocuments.Add DocumentType:=wdNewBlankDocumentSelection.PasteAndFormat (wdPasteDefault)'若无目录则创建If Dir("D:\backup\140591\桌面\报告temp\", vbDirectory) = "" Then MkDir "D:\backup\140591\桌面\报告temp\"ActiveDocument.SaveAs FileName:="D:\backup\140591\桌面\报告temp\" & FileName, FileFormat:=wdFormatHTML, _LockComments:=False, Password:="", AddToRecentFiles :=True, WritePassword _:="", ReadOnlyRecommended:=False, EmbedTrueTypeFont s:=False, _SaveNativePictureFormat:=False, SaveFormsData:=False , SaveAsAOCELetter:= _FalseActiveWindow.View.Type = wdWebView'段与段顶多只隔一行，将任意个回车符号替换成二个With Selection.Find.Text = "(^13)@".Replacement.Text = "^p^p".Forward = True.Wrap = wdFindContinue.MatchByte = False.MatchWildcards = TrueEnd WithSelection.Find.Execute Replace:=wdReplaceAll'全选+剪切Selection.WholeStorySelection.CutActiveDocument.Close FalseApplication.ScreenUpdating = TrueMsgBox "已完成！"End Sub8.Word 删除新闻中的多余代码和文字Sub 新闻排版()'''选择性粘贴Selection.PasteAndFormat (wdPasteDefault)Selection.Find.ClearFormattingSelection.Find.Replacement.ClearFormatting'删图片Dim oInlineShape As InlineShapeFor Each oInlineShape In ActiveDocument.InlineShapes oInlineShape.DeleteNext'取消所有超链接Dim cc As FieldFor Each cc In ActiveDocument.FieldsIf cc.Type = wdFieldHyperlink Thencc.UnlinkEnd IfNextSet cc = Nothing'删(微博)[微博]With Selection.Find.Text = "[\（\(]微博[\）\)]".Replacement.Text = "".Forward = True.Wrap = wdFindContinue.MatchByte = False.MatchWildcards = TrueEnd WithSelection.Find.Execute Replace:=wdReplaceAll'删(博客,微博)With Selection.Find.Text = "(博客,微博)".Replacement.Text = "^p^p".Forward = True.Wrap = wdFindContinue.MatchByte = True.MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAll'删象屿期货的段前符号With Selection.Find.Text = ChrW(61548).Replacement.Text = "".Forward = True.Wrap = wdFindContinue.MatchByte = True.MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAll'删小标题后的/With Selection.Find.Text = "/^p".Replacement.Text = "^p".Forward = True.Wrap = wdFindContinue.MatchByte = True.MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAll'删股票代码With Selection.Find.Text = "[\-0−9.]1,[,s]1,[\-0−9.]1,[,s]1,[\-0−9. ".Replacement.Text = "".Forward = True.Wrap = wdFindContinue.MatchByte = False.MatchWildcards = TrueEnd WithSelection.Find.Execute Replace:=wdReplaceAll'删股票涨跌值With Selection.Find.Text = "[\-0−9.".Replacement.Text = "".Forward = True.Wrap = wdFindContinue.MatchByte = False.MatchWildcards = TrueEnd WithSelection.Find.Execute Replace:=wdReplaceAll'删[2.98% 资金研报]With Selection.Find.Text = "[\-0−9.".Replacement.Text = "".Forward = True.Wrap = wdFindContinue.MatchByte = False.MatchWildcards = TrueEnd WithSelection.Find.Execute Replace:=wdReplaceAll'删(600648,股吧)With Selection.Find.Text = "[0−9]6,[股吧基金]2,3 ".Replacement.Text = "".Forward = True.Wrap = wdFindContinue.MatchByte = False.MatchWildcards = TrueEnd WithSelection.Find.Execute Replace:=wdReplaceAll'手动换行符替换成回车符With Selection.Find.Text = "^l".Replacement.Text = "^p".Forward = True.Wrap = wdFindContinue.MatchByte = True.MatchWildcards = FalseEnd WithSelection.Find.Execute Replace:=wdReplaceAll'段与段顶多只隔一行，将任意个回车符号替换成二个With Selection.Find.Text = "(^13)@".Replacement.Text = "^p^p".Forward = True.Wrap = wdFindContinue.MatchByte = False.MatchWildcards = TrueEnd WithSelection.Find.Execute Replace:=wdReplaceAll'全选+剪切Selection.WholeStorySelection.CutEnd Sub9.Excel双击则复制单元格内容到剪切板Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69 }").SetText Target.PutInClipboardEnd WithEnd Sub10.用对话框打开Excel文件iFileName = Application.GetOpenFilename("Excel文件 (*.xlsx;*.xls), *.xlsx;*.xls")11.Excel按指定列升序排列With wbf.Sort.SortFields.Clear.SortFields.Add Key:=Range("B1"), SortOn:=xlSortOnValues, Order:=xlAscending 'descending，递减。

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.SelectSelection.Insert Shift:=xlDownSelection.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\" & fz = 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").ValueSet 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 = RngWorksheets("沪深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 <> 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 <> 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 + 1End IfNext '获得每一年的个数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)i = 1Do While filename <> ""If filename <> 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 <> 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（Visual Basic for Applications）是一种用于自动化任务和宏编程的编程语言。

它是Microsoft Office套件的一部分，用于自动执行重复的任务和增强办公软件的功能。

以下是一些常用的VBA代码汇总，供参考和学习：1.向单元格中填入数值或文本：```vbaRange("A1").Value = 10Range("A2").Value = "Hello, world!"```2.循环遍历单元格：```vbaFor Each cell In Range("A1:A10")'逐个处理单元格MsgBox cell.ValueNext cell```3.创建新的工作表：```vbaSet ws = Sheets.Add = "New Sheet"```4.删除工作表：```vbaSheets("Sheet1").Delete```5.自动筛选数据：```vbaActiveSheet.Range("A1:D10").AutoFilter Field:=1, Criteria1:="Apple"```6.打开文件对话框并选择文件：```vbaWith Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False.ShowIf .SelectedItems.Count > 0 ThenMsgBox .SelectedItems(1)MsgBox "No file selected."End IfEnd With```7.在单元格中执行计算：```vbaRange("C1").Formula = "=SUM(A1:B1)"```8.隐藏行或列：```vbaColumns("A").Hidden = TrueRows("1:5").Hidden = True```9.在单元格中显示当前日期和时间：```vbaRange("A1").Value = Now```10.复制和粘贴单元格：Range("A1").Copy Destination:=Range("B1")```11.保存文件：```vbaActiveWorkbook.SaveAs "C:\MyFolder\MyFile.xlsx"```12.打开网页并获取内容：```vbaSet objHTTP = CreateObject("MSXML2.ServerXMLHTTP") objHTTP.Open "GET", URL, FalseobjHTTP.SendMsgBox objHTTP.ResponseText```13.设置单元格格式：```vbaRange("A1").NumberFormat = "0.00"```14.创建图表：Set chartObj = ActiveSheet.Shapes.AddChart2(251, xlColumnClustered)chartObj.SelectActiveChart.SetSourceData Source:=Range("A1:B5")```15.在窗口中显示消息框：```vbaMsgBox "Hello, world!"```以上只是一些常见的VBA代码示例，可以根据具体需求进行修改和扩展。