vb表格宏命令

合集下载

vba宏表函数

vba宏表函数VBA宏表函数——提升Excel数据处理效率的利器VBA（Visual Basic for Applications）是微软公司开发的一种宏语言，广泛应用于Microsoft Office软件中，尤其是Excel。

利用VBA宏表函数，我们可以在Excel中编写自定义的宏代码来实现各种自动化操作，大大提升了数据处理的效率和准确性。

一、VBA宏表函数的基本概念及使用方法VBA宏表函数是一种用户自定义函数，可以在Excel中使用，其功能类似于内置函数，但更加灵活。

通过编写VBA宏表函数，我们可以自定义各种复杂的计算和操作，满足不同的需求。

使用VBA宏表函数的方法如下：1. 打开Excel，按下“ALT+F11”快捷键，打开VBA编辑器；2. 在VBA编辑器中，选择“插入”-“模块”，新建一个模块；3. 在模块中编写VBA代码，定义函数的名称、参数和返回值；4. 在Excel中使用自定义函数，就像使用内置函数一样，直接在单元格中输入函数名称和参数即可。

二、VBA宏表函数的应用场景1. 数据处理与分析VBA宏表函数可以帮助我们快速处理和分析大量的数据。

通过编写自定义的函数，我们可以实现各种复杂的计算和数据转换操作，节省大量的时间和精力。

例如，我们可以编写一个VBA宏表函数来计算某一列数据的平均值，并将结果显示在另一个单元格中。

这样，我们就能够快速得到大量数据的统计结果，而不需要手动进行计算。

2. 数据清洗与格式转换在进行数据清洗和格式转换时，VBA宏表函数也能发挥重要作用。

通过编写自定义的函数，我们可以自动化地进行各种复杂的数据清洗和格式转换操作，提高数据质量和准确性。

例如，我们可以编写一个VBA宏表函数来将一个字符串中的英文单词转换为大写，并将结果显示在另一个单元格中。

这样，我们就能够快速地将大量的文本数据进行格式转换，而不需要手动逐个修改。

3. 自动化报表生成VBA宏表函数还可以帮助我们自动化生成各种报表。

vba 常用宏代码

在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。

VB封装Excel宏代码的三个方法

VB封装Excel_VBA成DLL技巧使用VB6.0在WinXP_sp2、Excel 2000环境下制作、测试通过。

一、启动VB6.0：执行：“文件夹(F)”——“新建(N)”——选择“ActiveX DLL”，如下图1：二、引用：VB中对Excel的引用执行：“工程(P)”——“引用(N)”——选择所要引用的项目：如下图2Excel 2000中：Microsoft Excel 9.0 Object LibraryMicrosoft Office 9.0 Object LibraryExcel 2003中：Microsoft Excel 11.0 Object LibraryMicrosoft Office 11.0 Object Library三、编写代码：1、将工程默认名称“工程1”，改为“zygtest”，将类模块默认名称“Class1”，改为“zyg365”，2、在类模块的代码编辑区写入代码：如下图3模块名称为“hongtong”，代码如下在VB中编写代码时：要注意以下声名Dim XLAPP As ObjectSet XLAPP = GetObject(, "Excel.Application")代码中引用对象，如SHEET，Cell等，前面要加“XLAPP.”（或按照Sub hongtong() 中的格式编写。

）Sub hongtong()Dim excelApp As New Excel.ApplicationDim excelWorkBook As Excel.WorkbookDim excelWorksheet As Excel.WorksheetSet excelWorkBook = '创建新工作簿Set excelWorksheet = excelWorkBook.Sheets(1)excelWorksheet.Cells(2, 3) = "宏通" '写入数据excelWorksheet.Cells(3, 4) = "zyg365" '写入数据excelApp.Visible = True '显示excel界面，用于调试excelWorkBook.PrintPreview '打印预览excelWorkBook.PrintOut '打印输出excelWorkBook.Saved = True'excelWorkBook.Close '关闭工作薄'excelApp.Quit '退出excelEnd Sub四、工程属性设置：(可以不设置，本步骤可以省略)为了使自己开发的程序更规范，可以对本工程的属性加以描述：如下图4执行：“工程(P)”——“工程1属性(E)…”(当前工程中为：“zygtest属性(E)…”)五、保存工程、测试、打包生成Dll文件：1、保存：单击保存，保存到一个文件夹中；2、测试：执行工具栏上的“启动”(右向的三角图标)按钮，检查是否存在错误；3、打包生成Dll文件：执行：“文件(F)”——“生成工程1.dll(K)”(当前工程中为：“zygtest.dll”)，重命名为“zyg.dll”,至此，Dll文件制作结束。

vb表格宏命令

竭诚为您提供优质文档/双击可除vb表格宏命令篇一：利用宏命令锁定excel公式利用宏命令锁定excel公式为了防止excel里面做好的公式误被他人修改，通常大家会通过设置“保护工作表”的方式来锁定，但锁定后别人点击就会弹出对话框，很麻烦。

本文介绍一个通过宏命令来锁定公式的方式，别人根本无法点击锁定后的公式单元格，这样就显得很高大上：）一、录制宏打开excel20xx，在视图里面找到宏图标（20xx版本在工具菜单里寻找），如果没有找到，请打开文件菜单，底部进“选项”，点最下“信任中心”，进入“信任中心设置”，点击“宏设置”，启用宏，然后回到excel就能找到宏图标了。

点击“录制宏”选择保存在个人宏工作簿，确定然后点击右下角的二、编辑Vb宏命令按alt+F11，进入Vb工程界面蓝色方块，停止录制选择模块1，双击进入编辑模式将代码栏中的所有内容全部删除然后把以下代码复制进去（分割线中间）------------分割线--------------------sub保护公式()activesheet.unprotect("12345678")解除对工作表的保护cells.select选中整个表格selection.locked=False解除锁定selection.specialcells(xlcelltypeFormulas,23).selec t选中包含公式的单元格selection.locked=true添加锁定selection.Formulahidden=true添加隐藏activesheet.protect("12345678")保护工作表，并设置密码activesheet.enableselection=xlunlockedcells让锁定单元格不能选中endsub---------------分割线-----------------然后，结果如下图，请核对点击文件菜单，选择“关闭并返回excel”三、执行宏点击“查看宏”点击“执行”，就可以执行了（提示：无内容的空文档执行时会出错，别担心，打开一个有公式的文档，就可以顺利执行了）四、建立快捷方式点击“自定义快速访问工具栏”从下来菜单中选择宏，这时可以看到保护公式的宏，点“添加”在最顶上就可以看到宏了，以后打开文档后直接点击该按钮，就会自动执行保护公式的宏了。

excel宏教程-VB

Excel宏教程一、选中单个单元格Range(“<单元格地址>“).Select例：Range("C9").Select …选中“C9”单元格二、选中多个单元格Range(“<单元格地址>:<单元格地址>[,<单元格地址>……]”).Select例：Range(“A1:B2”).Select…选中“A1”、“A2”、“B1”、“B2”四个连续的单元格Range(“12:12”).Select…选中第12行Range(“B:B”).Select…选中第B列Range(“A1:A2,B7,2:2”).Select…选中“A1”、“A2”、“B7”五个不连续的单元格和第二行Cells.Select …选中当前SHEET中的所有单元格Rows("<行地址>:<行地址>").Select …选中整行Columns("<列地址>:<列地址>").Select …选中整列例：Rows(“2:2”). Select…选中第2行Rows(“2:5”). Select…选中2到5行Columns("A:A").Select …选中A列Columns("E:B").Select …选中E到B列三、设置活动单元格Range("<单元格地址>").Activate注：设置活动单元格与选中单元格类似，不同之处就是后者在选中指定的单元格之前会将在此前已被选中的单元格取消掉。

前者在设置之前不会取消已选中的单元格，如果此时操作的单元格不是被选中的单元格，这时他实现的功能与选一个单元格相同。

四、给活动的单元格赋值ActiveCell.FormulaR1C1 = <值>例：Range("A1").SelectActiveCell.FormulaR1C1 = "Name"Range("B1").SelectActiveCell.FormulaR1C1 = "Age"Range("A2:B3").SelectRange("A2").ActivateActiveCell.FormulaR1C1 = " BUG"Range("B2").ActivateActiveCell.FormulaR1C1 = "12"Range("A3").ActivateActiveCell.FormulaR1C1 = "Archer"Range("B3").ActivateActiveCell.FormulaR1C1 = "37"五、得到指定单元格中的值Range("<单元格地址>").Text六、插入单元格Selection.Insert Shift:=<XlDirection值>Selection.EntireRow.InsertSelection.EntireColumn.Insert例：Selection.Insert Shift:=xlToRight …在当前选中单元格的位置插入单元格并将当前选中的单元格向右移动Selection.Insert Shift:=xlDown …在当前选中单元格的位置插入单元格并将当前选中的单元格向下移动Selection.EntireRow.Insert …在当前选中单元格的上面插入一行Selection.EntireColumn.Insert …在当前选中单元格的左侧插入一列七、设置字体属性1. 设置字体名称和大小 = <字体名称>Selection.Font.Size = <字号>例： = "隶书"Selection.Font.Size = 152. 设置字体样式Selection.Font.Bold = <True / False> …加粗Selection.Font.Italic = <True / False> …斜体Selection.Font.Underline = < XlUnderlineStyle(下划线样式)> …下划线XlUnderlineStyle(下划线样式):xlUnderlineStyleDouble …双下划线xlUnderlineStyleDoubleAccounting …会计用双下划线（如果当前单元格中的数据是数字时则下划线的宽度是当前单元格的宽度）xlUnderlineStyleNone 没有下划线xlUnderlineStyleSingle …单下划线xlUnderlineStyleSingleAccounting …会计用单下划线（如果当前单元格中的数据是数字时则下划线的宽度是当前单元格的宽度）3. 设置字体的颜色Selection.Font.ColorIndex = <0到56之间的数字>Selection.Font.Color = <RGB值>4. 设置字体的特殊效果Selection.Font.Strikethrough = <True / False> …删除线Selection.Font.Superscript = <True / False> …上标Selection.Font.Subscript = <True / False> …下标八、清空选中单元格里的内容Selection.ClearContents例：Range(“A1:A2,B7,2:2”).Select …选中“A1”、“A2”、“B7”五个不连续的单元格和第二行Selection.ClearContents …清空“A1”、“A2”、“B7”五个不连续单元格中的所有内容九、设置选中单元格的边线属性XlBordersIndex(边线):xlEdgeLeft '单元格左边线xlEdgeTop …单元格上边线xlEdgeRight …单元格右边线xlEdgeBottom …单元格下边线xlDiagonalDown …单元格左上右下斜线xlDiagonalUp …单元格左上右下斜线xlInsideVertical …多个单元格内垂直线xlInsideHorizontal …多个单元格内水平线1. 设置边线的类型Selection.Borders(<边线>).LineStyle = < XlLineStyle(边线类型)>XlLineStyle(边线类型):xlLineStyleNone …无样式xlContinuous …单线xlDash …破折号线(间隔线)xlDashDot …破折号点线xlDashDotDot …破折号点点线xlDot …点线xlDouble …双横线xlSlantDashDot …斜点线2. 设置边线的宽度Selection.Borders(<边线>).Weight = <XlBorderWeight(边线的宽度值)>XlBorderWeight(宽度值):xlHairline …极细xlThin …细xlMedium …中等xlThick …粗3. 设置边线的颜色Selection.Borders(xlEdgeLeft).ColorIndex = <0到56之间的数字>Selection.Borders(xlEdgeLeft).Color = <RGB值>十、删除选中的单元格Selection.Delete <XlDirection值>Selection.EntireRow.DeleteSelection.EntireColumn.Delete例：Selection.Delete Shift:=xlToLeft …删除选中的单元格,并将已删除单元格所在位置右面的单元格向左移动Selection.Delete Shift:=xlUp …删除选中的单元格,并将已删除单元格所在位置下面的单元格向上移动Selection.EntireRow.Delete …删除选中单元格所在的行Selection.EntireColumn.Delete …删除选中单元格所在的列十一、设置单元格背景色及图案1. 背景色Selection.Interior.ColorIndex = <0到56之间的数字> Selection.Interior.Color = <RGB值>2. 图案样式Selection.Interior.Pattern = <Constants(图案样式)>Constants(图案样式):xlSolid '实心xlGray75 '75% 灰色xlGray50 '50% 灰色xlGray25 '25% 灰色xlGray16 '12.5% 灰色xlGray8 '6.25% 灰色xlHorizontal '水平条纹xlVertical '垂直条纹xlDown '逆对角线条纹xlUp '对角线条纹xlChecker '对角线剖面线xlSemiGray75 '粗对角线剖面线xlLightHorizontal '细水平条纹xlLightVertical '细垂直条纹xlLightDown '细逆对角线条纹xlLightUp '细对角线条纹xlGrid '细水平剖面线xlCrissCross '细对角线剖面线3. 图案颜色Selection.Interior.PatternColorIndex = <0到56之间的数字>Selection.Interior.PatternColor = <RGB值>十二、返回工作表中的行数edRange.Rows.Count …返回从最小已输入内容的行号到最大已输入内容的行号之间的行数edRange.Rows(edRange.Rows.Count).Row …最大已输入内容的行号十三、得到当前EXCEL的文件名ThisWorkbook.Path …文件路径 …文件名ThisWorkbook.FullName …全路径十四、批注的操作1. 添加批注AddComment([Content])例：Range("A1").AddComment ("Writes the content in here!")2. 修改批注内容Comment.Text例：Range("B1").Comment.Text Text:= "Writes the content in here!"3. 显示/隐藏批注Comment.Visible = <True/False>4. 删除批注ClearComments例：Selection.Range("B1").ClearComments5. 选中批注Comment.Shape.Select True例：Range("D8").Comment.Shape.Select True6. 改变批注大小和位置Selection.ShapeRange.ScaleWidth <宽度比例>, msoFalse, <MsoScaleFrom> Selection.ShapeRange.ScaleHeight <高度比例>, msoFalse, <MsoScaleFrom>例：Selection.ShapeRange.ScaleWidth 1.5, msoFalse, msoScaleFromTopLeft …每次增加5%的宽度Selection.ShapeRange.ScaleHeight 0.6, msoFalse, msoScaleFromTopLeft …每次减少6%的宽度Selection.ShapeRange.Left = <左边距>Selection.ShapeRange.Top = <上边距>Selection.ShapeRange.Width = <宽度值>Selection.ShapeRange.Height = <高度值>十五、剪切、复制、粘贴Selection.Cut …剪切Selection.Copy …复制ActiveSheet.Paste …粘贴例：Range("A1").SelectSelection.CutRange("A2").SelectActiveSheet.PasteSelection.CopyRange("A3").SelectActiveSheet.Paste十六、选择性粘贴Selection.PasteSpecial <option>十七、改变列宽Selection.ColumnWidth = <宽度值> …指定列宽例：Columns("A:A").SelectSelection.ColumnWidth = 30 …改变已选列的宽度EntireColumn.AutoFit …自动改变列宽例：Columns("C:C").EntireColumn.AutoFit …根据C列的内容自动改变列的宽度在Excel 97中，"宏"是一个难以理解的概念，但对于一个具体的"宏"而言，却是容易理解的，如果说"将一块文字变为注释：黑体注释：，字号为注释：三号注释："就可以看作一个"宏"的话，那么"宏"就不难理解了，其实Excel 97中的许多操作都可以是一个"宏"。

使用VBA实现Excel宏自动执行

使用VBA实现Excel宏自动执行在日常的工作和学习中，我们经常需要使用Excel进行数据的处理和分析。

有时候，我们需要频繁地执行相同的操作，例如按照特定的条件筛选数据、进行复杂的计算或者生成报表。

为了提高效率，我们可以使用VBA （Visual Basic for Applications）来实现Excel宏的自动执行。

本文将介绍如何使用VBA来实现Excel宏的自动执行，提高工作效率。

首先，我们需要打开Excel的开发工具。

在Excel的菜单栏中选择“文件”->“选项”->“自定义功能区”，找到“开发工具”并勾选上。

然后点击“确认”按钮，即可在菜单栏中看到“开发工具”选项。

接下来，我们需要创建一个宏。

在菜单栏中选择“开发工具”->“宏”，然后点击“新建”按钮。

在弹出的对话框中输入宏的名称，并点击“创建”按钮。

这时，Excel会打开VBA编辑器窗口，我们可以在这里编写VBA代码。

在VBA编辑器窗口中，我们可以使用各种Excel提供的对象和方法来实现宏的功能。

例如，我们可以使用“Range”对象来操作单元格，使用“Selection”对象来操作选中的区域，使用“Worksheet”对象来操作工作表等。

通过编写VBA代码，可以实现各种复杂的操作，例如数据的筛选、排序、计算以及生成报表等。

在编写VBA代码时，我们可以使用各种控制结构和函数来实现代码的逻辑。

例如，我们可以使用“if-then-else”语句实现条件判断，使用“for-next”语句实现循环操作，使用“select-case”语句实现多条件判断等。

此外，我们还可以使用各种函数来对数据进行处理，例如字符串的处理、日期的处理、数学运算等。

完成宏的编写后，我们需要保存并关闭VBA编辑器窗口。

然后，在Excel的菜单栏中选择“开发工具”->“宏”，选择刚才编写的宏，并点击“运行”按钮。

这时，Excel会自动执行宏，并按照编写的代码进行操作。

各种ExcelVBA的命令2-电脑资料

各种ExcelVBA的命令2-电脑资料本示例重复最近用户界面命令，。

本示例必须放在宏的第一行。

Application.Repeat下例中，变量counter 代替了行号。

此过程将在单元格区域C1:C20 中循环，将所有绝对值小于 0.01 的数字都设置为 0（零）。

Sub RoundToZero1()For Counter = 1 To 20Set curCell = Worksheets("Sheet1").Cells(Counter, 3)If Abs(curCell.Value) 0 Then' Application.ActivePRinter = "\\zdserver2\HP LaserJet 5000 PCL 6在 Ne00:" '指定打印机ActiveWindow.SelectedSheets.PrintOutCopies:=myPrintNum,Collate:=True '设置打印信息,其中Copies:=myPrint为打印份数ElseMsgBox "请输入要打印的份数"End IfActiveSheet.ShowAllData '全部显示ActiveSheet.Protect Password:=641112 ' 保护工作表并设置密码Sheets("封面").SelectApplication.ScreenUpdating = TrueEnd SubSub 打印余额()Application.ScreenUpdating = FalseSheets("余额表").SelectCall 重算所有表ActiveSheet.Unprotect Password:=641112 '撤消工作表保护并取消密码ActiveWindow.ScrollColumn = 10Selection.AutoFilter Field:=1, Criteria1:=""'以下10行弹出窗口输入打印信息Dim myPrintNum As IntegerDim myPrompt, myTitle As StringmyPrompt = "请输入要打印的份数"myTitle = "打印选取范围"myPrintNum = Application.InputBox(myPrompt, myTitle, 4, , , , , 1)If myPrintNum 0 Then' Application.ActivePrinter = "\\zdserver2\HP LaserJet 5000 PCL 6 在Ne00:" ' '指定打印机ActiveWindow.SelectedSheets.PrintOutCopies:=myPrintNum,Collate:=True '设置打印信息,其中Copies:=myPrint为打印份数ElseMsgBox "请输入要打印的份数"End IfActiveSheet.ShowAllData '全部显示ActiveSheet.Protect Password:=641112 ' 保护工作表并设置密码Sheets("封面").SelectApplication.ScreenUpdating = TrueEnd SubSub 备份()Dim y '变量声明-需保存工作表的路径和名称[M1] = ActiveWorkbook.FullName '单元格M1=当前工作簿的路径和名称y = cells(1, 14) 'Y=单元格N1的值,即计算后的需保存工作簿的路径和名称Worksheets("封面").UsedRange.Columns("M:N").Calculate '计算指定区域ActiveWorkbook.SaveCopyAs y '备份到指定路么YEnd SubSub 重算活动表()With Application.Calculation = xlManual.MaxChange = 0.001End WithActiveWorkbook.PrecisionAsDisplayed = TrueActiveWindow.DisplayZeros = TrueActiveSheet.CalculateEnd SubSub 重算指定表()Attribute 重算指定表.VB_ProcData.VB_Invoke_Func = "z\n14"Worksheets("银行帐").CalculateWorksheets("日报表").CalculateEnd Sub单元格数据改变引起计算激活过程Private Sub Worksheet_Change(ByVal Target As Range)Dim irow, icol As Integerirow = Target.Row '变量行irowicol = Target.Column '变量列icolIf irow > 6 And icol = 3 And cells(irow, 3) >= cells(irow - 1, 3)Then '>大于6行,并且第3列,当本行 3列>2行3列Application.EnableEvents = Falsecells(irow, 2) = cells(irow - 1, 2) '本行 2 列=上一行2列Application.EnableEvents = TrueElseIf irow > 6 And icol = 3 And cells(irow, 3) 大于6行,并且第3列,当本行 3列>2行3列Application.EnableEvents = Falsecells(irow, 2) = cells(irow - 1, 2) + 1 '本行 2 列=上行2列+1Application.EnableEvents = TrueElseIf (icol = 3 Or icol = 4 Or icol = 6 Or icol = 8 Or icol = 9 Oricol = 10 Or icol = 12 Or icol = 13) And irow > 6 Then 'And Target""Application.EnableEvents = Falsecells(irow, 5) = "=单位名称"cells(irow, 7) = "=摘要"cells(irow, 11) = "=余额"Range(cells(irow, 14), cells(irow, 16)) = "=预内外收支NOP"cells(irow, 17) = "=审核Q"cells(irow, 18) = "=对帐U"Range(cells(irow, 19), cells(irow, 20)) = "=内转收支XY"cells(irow, 21) = "=政采Z"Application.EnableEvents = TrueEnd IfEnd Sub'计算当前工作表路径及名称的函数,可作为单元格公式,也可写入宏=CELL("FILENAME")'改变Excel界面标题的宏Private Sub Workbook_Open()Application.Caption = "吃过了"End Sub'自动刷新单元格A1内显示的日期\时间的宏Sub mytime()Range("a1") = Now()Application.OnTime Now + TimeValue("00:00:01"), "mytime"End Sub'用单元格A1的内容作为文件名保存当前工作簿的宏Sub b()ActiveWorkbook.SaveCopyAs Range("A1") + ".xls"End Sub'激活窗体的宏,此宏写入有窗体的工作表内Private Sub CommandButton1_Click() '点数据录入按钮控件激活窗体Load UserForm3 '激活窗体UserForm3.StartUpPosition = 3 '激活窗体UserForm3.Show '激活窗体End Sub'以下为窗体中点击各按钮运行的宏,写入窗体内Public pos As Integer '声明变量pos'战友确定按钮语句Private Sub CommandButton1_Click()Application.ScreenUpdating = False '此句和最后一句旨在不显示宏的执行过程'On Error GoTo ErrorHandle '可以不要'ErrorHandle: '可以不要'If Err.Number = 13 Then '可以不要'Exit Sub '可以不要'End If '可以不要Call writeToWorkSheet '执行宏writetoworksheetUserForm3.Hide '退出窗体,继续按钮少此句,退出按钮执行此句Unload UserForm3 '退出窗体,继续按钮少此句,退出按钮执行此句Call 批量打印 '[此处到接顺序2][L2] = "" '[到此处结束]Sheets("打印信息").SelectApplication.ScreenUpdating = TrueEnd Sub'退出按钮语句Private Sub CommandButton2_Click()UserForm3.HideUnload UserForm3End Sub'将窗体内的文本框中的数据写进工作表的单元格Private Sub writeT oWorkSheet()ActiveSheet.Range("k2") = TextBox1.Value '将文字框内容写进k列ActiveSheet.Range("l2") = TextBox2.Value '将文字框内容写进l 列TextBox1.Value = "" '清空文字框内容TextBox2.Value = "" '清空文字框内容Worksheets("打印信息").Range("a2").Value = 1 '给指定表的单元格写入数据Worksheets("打印信息").Range("B3:E113").Value = "" '清空指定表的单元格数据End Sub'以下为根据条件打印的宏Sub 打印() '部门明细查询及批星打印Application.ScreenUpdating = False '关闭屏幕更新If Cells(1, 4) = "" And Cells(1, 5) = "" Then '打印条件Cells(3,13) = 1 And' Application.ActivePrinter = "\\zdserver2\HP LaserJet 5000 PCL6 在 Ne00:" ' '指定打印机ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True'设置默认打印机的打印信息,其中Copies:=myPrint为打印份数ElseCall 打印信息 '打倒为假时执行End IfApplication.ScreenUpdating = True '关闭屏幕更新End Sub'以下的循环过程,也用于批量打印,Z的值可以是Z=1 TO 5(1到5),也可是单元格的内容Sub 批量打印()For Z = Cells(1, 11) To Cells(1, 12) '变量X的值从打印起始号K1到结束号L1之间逐渐递增Cells(1, 13) = Z 'M1的值等于变量XEnd Sub'以下是将打印情况写入工作表的宏Sub 打印信息()Application.ScreenUpdating = False '关闭屏幕更新Dim Y '声明变量Y = '判定活动工作表名称Sheets("打印信息").SelectX = 3 '从第3行开始Do While Not (IsEmpty(Cells(X, 2).Value)) '判断第1列的最后一行(即空行的上一行)X = X + 1 '在最后一行加一行即为空行LoopCells(X, 2) = Cells(2, 1)Cells(X, 3) = Sheets(Y).Cells(4, 3)Cells(2, 1) = Cells(2, 1) + 1Cells(X, 4) = Sheets(Y).Cells(1, 4)Cells(X, 5) = Sheets(Y).Cells(1, 5)[c1] = YSheets(Y).Select '返回上一次打开的工作表Application.ScreenUpdating = True '打开屏幕更新End Sub将文件保存为以某一单元格中的值为文件名的宏怎么写假设你要以Sheet1的A1单元格中的值为文件名保存，则应用命令：ActiveWorkbook.SaveCopyAs Str(Range("Sheet1!A1")) + ".xls"在Excel中,如何用程式控制某一单元格不可编辑修改?thanks Private Sub Workbook_Open()ProtectSpecialRange ("A1")Sub ProtectSpecialRange(RangeAddress As String)On Error Resume NextWith Sheet1.Cells.Locked = False.Range(RangeAddress).Locked = True.Protection.AllowEditRanges.Add Title:="区域1", Range:=Range(RangeAddress) _, Password:="pass".Protect DrawingObjects:=True, Contents:=True, Scenarios:=TrueEnd WithEnd Sub对工作表编程，有时要判断工作表的记录总数，VBA里如何实现？x=1do while not (isempty(sheets("").cells(x,1).value)x=x+1loop在VBA中等同于EXCELE中的求和函数-sum()-的函数是什么?Application.WorksheetFunction.Sum()自定义菜单有三个菜单项，要求手工顺序执行，电脑资料《各种Excel VBA的命令2》(https://www.)。

Excel-vba宏代码-大全

宏文件集▲打开全部隐藏工作表返回Sub 打开全部隐藏工作表()Dim i As IntegerFor i = 1 To Sheets.CountSheets(i).Visible = TrueNext iEnd Sub▲循环宏返回Sub 循环()AAA = Range("C2")Dim i As LongDim times As Longtimes = AAA'times代表循环次数，执行前把times赋值即可(不可小于1，不可大于2147483647)For i = 1 To timesCall 过滤一行If Range("完成标志") = "完成" Then Exit For '如果名为'完成标志'的命名单元的值等于'完成',则退出循环,如果一开始就等于'完成',则只执行一次循环就退出'If Sheets("传送参数").Range("A" & i).Text = "完成" Then Exit For '如果某列出现"完成"内容则退出循环Next iEnd Sub▲录制宏时调用“停止录制”工具栏返回Sub 录制宏时调用停止录制工具栏()mandBars("Stop Recording").Visible = TrueEnd Sub▲高级筛选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 Sub▲双击单元执行宏(工作表代码)返回Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)If Range("$A$1") = "关闭" Then Exit 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 Sub▲双击指定区域单元执行宏(工作表代码)返回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 Sub▲进入单元执行宏(工作表代码)返回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 Sub▲进入指定区域单元执行宏(工作表代码)返回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 Sub▲在多个宏中依次循环执行一个（控件按钮代码）返回Private Sub CommandButton1_Click()Static RunMacro As IntegerSelect Case RunMacroCase 0宏1RunMacro = 1Case 1宏2RunMacro = 2Case 2宏3RunMacro = 0End SelectEnd Sub▲在两个宏中依次循环执行一个并相应修改按钮名称（控件按钮代码）返回Private Sub CommandButton1_Click()With CommandButton1If .Caption = "保护工作表" ThenCall 保护工作表.Caption = "取消工作表保护"Exit SubEnd IfIf .Caption = "取消工作表保护" ThenCall 取消工作表保护.Caption = "保护工作表"Exit SubEnd IfEnd WithEnd Sub▲在三个宏中依次循环执行一个并相应修改按钮名称（控件按钮代码）返回Option ExplicitPrivate 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 Sub▲根据A1单元文本隐藏/显示按钮（控件按钮代码）返回Private Sub Worksheet_SelectionChange(ByVal Target As Range)If Range("A1") > 2 ThenCommandButton1.Visible = 1ElseCommandButton1.Visible = 0End IfEnd SubPrivate Sub CommandButton1_Click()重排窗口End Sub▲当前单元返回按钮名称（控件按钮代码）返回Private Sub CommandButton1_Click()ActiveCell = CommandButton1.CaptionEnd Sub▲当前单元内容返回到按钮名称（控件按钮代码）返回Private Sub CommandButton1_Click()CommandButton1.Caption = ActiveCellEnd Sub▲奇偶页分别打印返回Sub 奇偶页分别打印()Dim i%, Ps%Ps = ExecuteExcel4Macro("GET.DOCUMENT(50)") '总页数MsgBox "现在打印奇数页,按确定开始."For i = 1 To Ps Step 2ActiveSheet.PrintOut from:=i, To:=iNext iMsgBox "现在打印偶数页,按确定开始."For i = 2 To Ps Step 2ActiveSheet.PrintOut from:=i, To:=iNext iEnd Sub▲自动打印多工作表第一页返回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 Sub▲查找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 = 1 To 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 Sub▲将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 ThenPic.Top = Pic.TopLeftCell.TopPic.Left = Pic.TopLeftCell.LeftPic.Height = Pic.TopLeftCell.HeightPic.Width = Pic.TopLeftCell.WidthEnd IfNextEnd Sub▲返回光标所在行数返回Sub 返回光标所在行数()x = ActiveCell.RowRange("A1") = xEnd Sub▲在A1返回当前选中单元格数量返回Sub 在A1返回当前选中单元格数量()[A1] = Selection.CountEnd Sub▲返回当前工作簿中工作表数量返回Sub 返回当前工作簿中工作表数量()t = Application.Sheets.CountMsgBox tEnd Sub▲返回光标选择区域的行数和列数返回Sub 返回光标选择区域的行数和列数()x = Selection.Rows.County = Selection.Columns.CountRange("A1") = xRange("A2") = yEnd Sub▲工作表中包含数据的最大行数返回Sub 包含数据的最大行数()n = Cells.Find("*", , , , 1, 2).RowMsgBox nEnd Sub▲返回A列数据的最大行数返回Sub 返回A列数据的最大行数()n = Range("a65536").End(xlUp).RowRange("B1") = nEnd Sub▲将所选区域文本插入新建文本框返回Sub 将所选区域文本插入新建文本框()For Each rag In Selectionn = n & rag.Value & Chr(10)NextActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, ActiveCell.Left +ActiveCell.Width, ActiveCell.Top + ActiveCell.Height, 250#, 100).SelectSelection.Characters.Text = "问题：" & nWith Selection.Characters(Start:=1, Length:=3).Font.Name = "黑体".FontStyle = "常规".Size = 12End WithEnd Sub▲批量插入地址批注返回Sub 批量插入地址批注()On Error Resume NextDim r As RangeIf Selection.Cells.Count > 0 ThenFor Each r In Selectionment.Deleter.AddCommentment.Visible = Falsement.Text Text:="本单元格：" & r.Address & " of " & Selection.AddressNextEnd IfEnd Sub▲批量插入统一批注返回Sub 批量插入统一批注()Dim r As Range, msg As Stringmsg = InputBox("请输入欲批量插入的批注", "提示", "随便输点什么吧")If Selection.Cells.Count > 0 ThenFor Each r In Selectionr.AddCommentment.Visible = Falsement.Text Text:=msgNextEnd IfEnd Sub▲以A1单元内容批量插入批注返回Sub 以A1单元内容批量插入批注()Dim r As RangeIf Selection.Cells.Count > 0 ThenFor Each r In Selectionr.AddCommentment.Visible = Falsement.Text Text:=[a1].TextNextEnd IfEnd Sub▲不连续区域插入当前文件名和表名及地址返回Sub 批量插入当前文件名和表名及地址()For Each mycell In Selectionmycell.FormulaR1C1 = "[" + + "]" + +"!" + mycell.AddressNextEnd Sub▲不连续区域录入当前单元地址返回Sub 区域录入当前单元地址()For Each mycell In Selectionmycell.FormulaR1C1 = mycell.AddressNextEnd Sub▲连续区域录入当前单元地址返回Sub 连续区域录入当前单元地址()Selection = "=ADDRESS(ROW(),COLUMN(),4,1)"Selection.CopySelection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _:=False, Transpose:=FalseEnd Sub▲返回当前单元地址返回Sub 返回当前单元地址()d = ActiveCell.Address[A1] = dEnd Sub▲不连续区域录入当前日期返回Sub 区域录入当前日期()Selection.FormulaR1C1 = Format(Now(), "yyyy-m-d")End Sub▲不连续区域录入当前数字日期返回Sub 区域录入当前数字日期()Selection.FormulaR1C1 = Format(Now(), "yyyymmdd")End Sub▲不连续区域录入当前日期和时间返回Sub 区域录入当前日期和时间()Selection.FormulaR1C1 = Format(Now(), "yyyy-m-d h:mm:ss")End Sub▲不连续区域录入对勾返回Sub 批量录入对勾()Selection.FormulaR1C1 = "√"End Sub▲不连续区域录入当前文件名返回Sub 批量录入当前文件名()Selection.FormulaR1C1 = End Sub▲不连续区域添加文本返回Sub 批量添加文本()Dim s As RangeFor Each s In Selections = s & "文本内容"NextEnd Sub▲不连续区域插入文本返回Sub 批量插入文本()Dim s As RangeFor Each s In Selections = "文本内容" & sNextEnd Sub▲从指定位置向下同时录入多单元指定内容返回Sub 从指定位置向下同时录入多单元指定内容()Dim arrarr = Array("1", "2", "13", "25", "46", "12", "0", "20")[B2].Resize(8, 1) = Application.WorksheetFunction.Transpose(arr)End Sub▲按aa工作表A列的内容排列工作表标签顺序返回Sub 按aa工作表A列的内容排列工作表标签顺序()Dim I%, str1$I = 1Sheets("aa").SelectDo While Cells(I, 1).Value <> ""str1 = Trim(Cells(I, 1).Value)Sheets(str1).SelectSheets(str1).Move after:=Sheets(I)I = I + 1Sheets("aa").SelectLoopEnd Sub▲以A1单元文本作表名插入工作表返回Sub 以A1单元文本作表名插入工作表()Dim nm As Stringnm = [a1]Sheets.Add = nmEnd Sub▲删除全部未选定工作表返回Sub 删除全部未选定工作表()Dim sht As Worksheet, n As Integer, iFlag As BooleanDim ShtName() As Stringn = ActiveWindow.SelectedSheets.CountReDim ShtName(1 To n)n = 1For Each sht In ActiveWindow.SelectedSheetsShtName(n) = n = n + 1NextApplication.DisplayAlerts = FalseFor Each sht In SheetsiFlag = FalseFor i = 1 To n - 1If ShtName(i) = TheniFlag = TrueExit ForEnd IfNextIf Not iFlag Then sht.DeleteNextApplication.DisplayAlerts = TrueEnd Sub▲工作表标签排序返回Sub 工作表标签排序()Dim i As Long, j As Long, nums As Long, msg As Longmsg = MsgBox("工作表按升序排列请选 '是[Y]'. " & vbCrLf & vbCrLf & "工作表按降序排列请选 '否[N]'", vbYesNoCancel, "工作表排序")If msg = vbCancel Then Exit Subnums = Sheets.CountIf msg = vbYes Then 'Sort ascendingFor i = 1 To numsFor j = i To numsIf UCase(Sheets(j).Name) < UCase(Sheets(i).Name) ThenSheets(j).Move Before:=Sheets(i)End IfNext jNext iElse 'Sort descendingFor i = 1 To numsFor j = i To numsIf UCase(Sheets(j).Name) > UCase(Sheets(i).Name) ThenSheets(j).Move Before:=Sheets(i)End IfNext jNext iEnd IfEnd Sub▲定义指定工作表标签颜色返回Sub 定义指定工作表标签颜色()Sheets("Sheet1").Tab.ColorIndex = 46End Sub▲在目录表建立本工作簿中各表链接目录返回Sub 在目录表建立本工作簿中各表链接目录()Dim s%, Rng As RangeOn Error Resume NextSheets("目录").ActivateIf Err = 0 ThenSheets("目录").UsedRange.DeleteElseSheets.Add = "目录"End IfFor i = 1 To Sheets.CountIf Sheets(i).Name <> "目录" Thens = s + 1Set Rng = Sheets("目录").Cells(((s - 1) Mod 20) + 1, (s - 1) \ 20 + 1 + 1)Rng = Format(s, " 0") & ". " & Sheets(i).NameActiveSheet.Hyperlinks.Add Rng, "#" & Sheets(i).Name & "!A1",ScreenTip:=Sheets(i).NameEnd IfNextSheets("目录").Range("b:iv").EntireColumn.ColumnWidth = 20End Sub▲建立工作表文本目录返回Sub 建立工作表文本目录()Sheets.Add before:=Sheets(1)Sheets(1).Name = "目录"For i = 2 To Sheets.CountCells(i - 1, 1) = Sheets(i).Name'Sheets(1).Hyperlinks.Add Cells(i - 1, 1), "#" & Sheets(i).Name & "!A1" '添加超链接NextEnd Sub▲查另一文件的全部表名返回Sub 查另一文件的全部表名()On Error Resume NextDim i%Dim sh As WorksheetApplication.ScreenUpdating = FalseWorkbooks.Open Filename:=ThisWorkbook.Path & "\2.xls"Windows("1.xls").Activate '当前文件名称Sheets("Sheet1").Select '当前表名称i = 1 '将表名称返回到第1行For Each sh In Workbooks("2.xls").WorksheetsCells(i, 1) = '将表名称返回到第1列i = i + 1 '返回每个表名称向下移动1行Next shWindows("2.xls").Close '关闭对象文件Application.ScreenUpdating = TrueEnd Sub▲当前单元录入计算机名返回Sub 当前单元录入计算机名()Selection = Environ("COMPUTERNAME")'Selection = Workbooks("临时表").Sheets("表2").Range("A1") 调用指定地址内容End Sub▲当前单元录入计算机用户名返回 Sub 当前单元录入计算机用户名()Selection = Environ("Username")'Selection = Workbooks("临时表").Sheets("表2").Range("A1") 调用指定地址内容End Sub▲解除全部工作表保护返回Sub 解除全部工作表保护()Dim n As IntegerFor n = 1 To Sheets.CountSheets(n).UnprotectNext nEnd Sub▲为指定工作表加指定密码保护表返回Sub 为指定工作表加指定密码保护表()Sheet10.Protect Password:="123"End Sub▲在有密码的工作表执行代码返回Sub 在有密码的工作表执行代码()Sheets("1").Unprotect Password:=123 '假定表名为“1”，密码为“123” 打开工作表Range("C:C").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True '隐藏C列空值行Sheets("1").Protect Password:=123 '重新用密码保护工作表End Sub▲执行前需要验证密码的宏(控件按钮代码)返回Private Sub CommandButton1_Click()If InputBox("请输入密码：") <> "123" Then '密码是123MsgBox "密码错误,按确定退出!", 64, "提示"Exit SubEnd IfCells(1, 1) = 10End SubSub 执行前需要验证密码的宏()If InputBox("请输入您的使用权限:", "系统提示") = 123 Then重排窗口 '要执行的宏代码或宏名称ElseMsgBox "对不起,您没有使用该宏的权限,按确定键后退出!"End IfEnd Sub▲拷贝A1公式和格式到A2返回Sub 拷贝A1公式到A2()Workbooks("临时表").Sheets("表1").Range("A1").CopyWorkbooks("临时表").Sheets("表2").Range("A2").PasteSpecialEnd Sub▲复制单元数值返回Sub 复制数值()s = Workbooks("book1").Sheets("Sheet1").Range("A1:A2")Workbooks("book2").Sheets("Sheet1").Range("A1:A2") = sEnd Sub▲插入数值条件格式返回Sub 插入数值条件格式()Selection.FormatConditions.DeleteSelection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _Formula1:="70"Selection.FormatConditions(1).Interior.ColorIndex = 45Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _Formula1:="55"Selection.FormatConditions(2).Interior.ColorIndex = 39Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _Formula1:="60"Selection.FormatConditions(3).Interior.ColorIndex = 34End Sub▲插入透明批注返回Sub 插入透明批注()Selection.AddCommentment.Visible = FalseDim XS As WorksheetFor i = 1 To ments.Countments(i).Text "透明批注"ments(i).Shape.Fill.Visible = msoFalseNextEnd Sub▲添加文本返回Sub 添加文本()Selection = Selection + "×" '不可在数字后添加文本'Selection = Workbooks("临时表").Sheets("表2").Range("A1") 调用指定地址内容End Sub▲光标定位到指定工作表A列最后数据行下一单元返回Sub 光标定位到指定工作表A列最后数据行下一单元()a = Sheets("数据库").[a65536].End(xlUp).RowSheets("数据库").SelectRange("A" & a + 1).SelectEnd Sub▲定位选定单元格式相同的全部单元格返回Sub 定位选定单元格式相同的全部单元格()Dim FirstCell As Range, FoundCell As RangeDim AllCells As RangeWith Application.FindFormat.Clear.NumberFormatLocal = Selection.NumberFormatLocal.HorizontalAlignment = Selection.HorizontalAlignment.VerticalAlignment = Selection.VerticalAlignment.WrapText = Selection.WrapText.Orientation = Selection.Orientation.AddIndent = Selection.AddIndent.IndentLevel = Selection.IndentLevel.ShrinkToFit = Selection.ShrinkToFit.MergeCells = Selection.MergeCells = .Font.FontStyle = Selection.Font.FontStyle.Font.Size = Selection.Font.Size.Font.Strikethrough = Selection.Font.Strikethrough.Font.Subscript = Selection.Font.Subscript.Font.Underline = Selection.Font.Underline.Font.ColorIndex = Selection.Font.ColorIndex.Interior.ColorIndex = Selection.Interior.ColorIndex.Interior.Pattern = Selection.Interior.Pattern.Locked = Selection.Locked.FormulaHidden = Selection.FormulaHiddenEnd WithSet FirstCell = edRange.Find(what:="", searchformat:=True)If FirstCell Is Nothing ThenExit SubEnd IfSet AllCells = FirstCellSet FoundCell = FirstCellDoSet FoundCell = edRange.Find(After:=FoundCell, what:="",searchformat:=True)If FoundCell Is Nothing Then Exit DoSet AllCells = Union(FoundCell, AllCells)If FoundCell.Address = FirstCell.Address Then Exit DoLoopAllCells.SelectEnd Sub▲按当前单元文本定位返回Sub 按当前单元文本定位()ABC = SelectionDim aa As RangeFor Each a In edRangeIf a Like ABC ThenIf aa Is Nothing ThenSet aa = a.CellsElseSet aa = Union(aa, a.Cells)End IfEnd IfNextaa.SelectEnd Sub▲按固定文本定位返回Sub 文本定位()Dim aa As RangeFor Each a In edRangeIf a Like "*合计*" ThenIf aa Is Nothing ThenSet aa = a.CellsElseSet aa = Union(aa, a.Cells)End IfEnd IfNextaa.SelectEnd Sub▲删除包含固定文本单元的行或列返回Sub 删除包含固定文本单元的行或列()DoCells.Find(what:="哈哈").ActivateSelection.EntireRow.Delete '删除行' Selection.EntireColumn.Delete '删除列Loop Until Cells.Find(what:="哈哈") Is NothingEnd Sub▲定位数据及区域以上的空值返回Sub 定位数据及区域以上的空值()Dim aa As RangeFor Each a In edRangeIf a Like 〈0 ThenIf aa Is Nothing ThenSet aa = a.CellsElseSet aa = Union(aa, a.Cells)End IfEnd IfNextaa.SelectEnd Sub▲右侧单元自动加5(工作表代码)返回Private Sub Worksheet_Change(ByVal Target As Range)Application.EnableEvents = FalseTarget.Offset(0, 1) = Target + 5Application.EnableEvents = TrueEnd Sub▲当前单元加2返回Sub 当前单元加2()Selection = Selection + 2'Selection = Workbooks("临时表").Sheets("表2").Range("A1") 调用指定地址内容End Sub▲A列等于A列减B列返回Sub A列等于A列减B列()For i = 1 To 23Cells(i, 1) = Cells(i, 1) - Cells(i, 2)NextEnd Sub▲用于光标选定多区域跳转指定单元(工作表代码)返回Private Sub Worksheet_SelectionChange(ByVal T As Range)a = Array([b6:b7], [e6], [h6])For i = 0 To 2If Not Application.Intersect(T, a(i)) Is Nothing Then[a1].Select: Exit ForEnd IfNextEnd Sub▲将A1单元录入的数据累加到B1单元（工作表代码）返回Private Sub Worksheet_Change(ByVal Target As Range)Dim t As LongIf Target.Address = "$A$1" Thent = Sheet1.Range("$B$1").ValueSheet1.Range("$B$1").Value = t + Target.ValueEnd IfEnd Sub▲在指定颜色区域选择单元时添加/取消"√"（工作表代码）返回Private Sub Worksheet_SelectionChange(ByVal Target As Range)Dim myrg As RangeFor Each myrg In TargetIf myrg.Interior.ColorIndex = 37 Then myrg = IIf(myrg <> "√", "√", "")NextEnd Sub▲在指定区域选择单元时添加/取消"√"（工作表代码）返回Private Sub Worksheet_SelectionChange(ByVal Target As Range)Dim Rng As RangeIf Target.Count <= 15 ThenIf Not Application.Intersect(Target, Range("D6:D20")) Is Nothing ThenFor Each Rng In SelectionWith RngIf .Value = "" Then.Value = "√"Else.Value = ""End IfEnd WithNextEnd IfEnd IfEnd Sub▲双击指定单元，循环录入文本（工作表代码）返回Private Sub Worksheet_BeforeDoubleClick(ByVal T As Range, Cancel As Boolean)If T.Address <> "$A$1" Then Exit SubCancel = TrueT = IIf(T = "好", "中", IIf(T = "中", "差", "好"))End Sub双击指定单元，循环录入文本（工作表代码）Dim nums As BytePrivate Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Address = "$A$1" Thennums = nums Mod 3 + 1Target = Mid("上中下", nums, 1)Target.Offset(1, 0).SelectEnd IfEnd Sub▲单元区域引用（工作表代码）返回Private Sub Worksheet_Activate()Sheet1.Range("A1:B3").Value = Sheet2.Range("A1:B3").ValueEnd Sub▲在指定区域选择单元时数值加1（工作表代码）返回Private Sub Worksheet_SelectionChange(ByVal Target As Range)If Not Application.Intersect([a1:e10], Target) Is Nothing ThenTarget = Val(Target) + 1End IfEnd Sub▲混合文本的编号返回Sub 混合文本的编号()Worksheets(1).Range("B2").Value = "北京" & (--(Mid(Worksheets(1).Range("B2"), 3,100)) + 1)End Sub▲指定区域单元双击数据累加（工作表代码）返回Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)If Not Application.Intersect([A1:Y100], Target) Is Nothing Thenoldvalue = Val(Target.Value)inputvalue = InputBox("请输入数量,按ENTER键确认!", "数值累加器")Target.Value = oldvalue + inputvalueEnd IfEnd Sub▲选择单元区域触发事件（工作表代码）返回Private Sub Worksheet_SelectionChange(ByVal Target As Range)If Target.Address = "$A$1:$B$2" ThenMsgBox "你选择了$A$1:$B$2单元"End IfEnd Sub▲当修改指定单元内容时自动执行宏（工作表代码）返回Private Sub Worksheet_Change(ByVal Target As Range)If Not Application.Intersect(Target, [B3:B4]) Is Nothing Then重排窗口End IfEnd Sub▲被指定单元内容限制执行宏返回Sub 被指定单元限制执行宏()If Range("$A$1") = "关闭" Then Exit Sub窗口End Sub▲双击单元隐藏该行（工作表代码）返回Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)Rows(Target.Row).Hidden = TrueEnd Sub▲高亮显示行（工作表代码）返回Private Sub Worksheet_SelectionChange(ByVal Target As Range)Cells.Interior.ColorIndex = 2Rows("1:2").Interior.ColorIndex = 40 '保持1至2行的颜色推荐39,22,40,Rows(Target.Row).Interior.ColorIndex = 35 '高亮推荐颜色35,20,24,34,37,40,15End Sub▲高亮显示行和列（工作表代码）返回Private Sub Worksheet_SelectionChange(ByVal Target As Range)Cells.Interior.ColorIndex = xlNoneRows(Target.Row).Interior.ColorIndex = 34Columns(Target.Column).Interior.ColorIndex = 34End Sub▲为指定工作表设置滚动范围（工作簿代码）返回Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target AsRange)Sheet1.ScrollArea = "A1:M30"End Sub▲在指定单元记录打印和预览次数（工作簿代码）返回Private Sub Workbook_BeforePrint(Cancel As Boolean)Range("A1") = 1 + Range("A1")End Sub▲自动数字金额转大写（工作表代码）返回Private Sub Worksheet_Change(ByVal M As Range)On Error Resume Nexty = Int(Round(100 * Abs(M)) / 100)j = Round(100 * Abs(M) + 0.00001) - y * 100f = (j / 10 - Int(j / 10)) * 10A = IIf(y < 1, "", Application.Text(y, "[DBNum2]") & "元")b = IIf(j > 9.5, Application.Text(Int(j / 10), "[DBNum2]") & "角", IIf(y < 1,"", IIf(f > 1, "零", "")))c = IIf(f < 1, "整", Application.Text(Round(f, 0), "[DBNum2]") & "分")M = IIf(Abs(M) < 0.005, "", IIf(M < 0, "负" & A & b & c, A & b & c))End Sub▲将全部工作表的A1单元作为单击按钮（工作簿代码）返回Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target AsRange)If Target.Address = "$A$1" ThenCall 宏名End IfEnd Sub▲闹钟——到指定时间执行宏（工作簿代码）返回Private Sub Workbook_Open()Application.OnTime ("11:45:00"), "提示1" '宏名字Application.OnTime ("12:00:00"), "提示2" '宏名字End Sub▲改变Excel界面标题的宏（工作簿代码）返回Private Sub Workbook_Open()Application.Caption = "春节快乐"End Sub▲在指定工作表的指定单元返回光标当前多选区地址（工作簿代码）返回Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target AsRange)Worksheets("表2").Range("A1") = Target.Address(0, 0)End Sub▲B列录入数据时在A列返回记录时间（工作表代码）返回Public Sub Worksheet_Change(ByVal Target As Range)If Target.Column = 2 ThenTarget.Offset(, -1) = NowEnd IfEnd Sub▲当指定区域修改时在其右侧的2个单元返回当前日期和时间（工作表代码）返回Public Sub Worksheet_Change(ByVal Target As Range)If Not Application.Intersect(Target, [A1:A1000]) Is Nothing ThenIf Target.Column = 1 ThenTarget.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 ThenIf Target.Column = 1 ThenTarget.Offset(, 1) = Format(Now(), "yyyy-mm-dd")Target.Offset(, 2) = Format(Now(), "h:mm:ss")End IfEnd IfEnd Sub▲指定单元显示光标位置内容（工作表代码）返回Private Sub Worksheet_SelectionChange(ByVal T As Range)Sheets(1).Range("A1") = SelectionEnd Sub▲每编辑一个单元保存文件返回Private Sub Worksheet_Change(ByVal Target As Range)ThisWorkbook.SaveEnd Sub▲指定允许编辑区域返回Sub 指定允许编辑区域()ActiveSheet.ScrollArea = "B8:G15"End Sub▲解除允许编辑区域限制返回Sub 解除允许编辑区域限制()ActiveSheet.ScrollArea = ""End Sub▲删除指定行返回Sub 删除指定行()Workbooks("临时表").Sheets("表2").Range("5:5").DeleteEnd Sub▲删除A列为指定内容的行返回Sub 删除A列为指定内容的行()Dim a, b As Integera = Sheet1.[a65536].End(xlUp).RowFor b = a To 2 Step -1If Cells(b, 1).Value = "删除" ThenRows(b).DeleteEnd IfNextEnd Sub▲删除A列非数字单元行返回Sub 删除A列非数字单元行()i = [a65536].End(xlUp).RowRange("A1:A" & i).SpecialCells(xlCellTypeConstants, 2).EntireRow.DeleteEnd Sub▲有条件删除当前行返回Sub 有条件删除当前行()If [A1] = 2 Or [B1] = "删除" ThenSelection.Delete Shift:=xlUpEnd IfEnd Sub▲选择下一行返回Sub 选择下一行()ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.SelectEnd Sub▲选择第5行开始所有数据行返回Sub 选择第5行开始所有数据行A()Dim i%i = Cells.Find("*", SearchOrder:=xlByRows, LookIn:=xlValues,SearchDirection:=xlPrevious).EntireRow.RowRows("5:" & i).SelectEnd SubSub 选择第5行开始所有数据行B()Rows("5:" & Cells.Find("*", , , , 1, 2).Row).SelectEnd Sub▲选择光标或选区所在行返回Sub 选择光标或选区所在行()Selection.EntireRow.Select▲选择光标或选区所在列返回Sub 选择光标或选区所在列()Selection.EntireColumn.SelectEnd Sub▲光标定位到名称指定位置返回Sub 定位()Application.Goto Range(Evaluate("名称"))End Sub▲选择名称定义的数据区返回Sub 选择名称定义的数据区()[数据区].Select '插入名称要使用INDIRECT函数'Range("数据区").Select 或者'Sheet1.Range("数据区").Select 或者End Sub▲选择到指定列的最后行返回Sub 选择到指定列的最后行()Range("C4:G" & [G65536].End(xlUp).Row).SelectEnd Sub▲将Sheet1的A列的非空值写到Sheet2的A列返回Sub 将Sheet1的A列的非空值写到Sheet2的A列()Sheet1.Columns("A:A").SpecialCells(2, 23).SpecialCells(12).Copy Sheet2.[A1]End Sub▲将名称1的数据写到名称2返回Sub Macro2()Range("位置2") = Range("位置1").Value▲单元反选返回Sub 单元反选()Application.DisplayAlerts = FalseApplication.ScreenUpdating = FalseDim raddress As String, taddress As Stringraddress = Selection.Addresstaddress = edRange.AddressWith Sheets.Add.Range(taddress) = 0.Range(raddress) = "=0"raddress = .Range(taddress).SpecialCells(xlCellTypeConstants, 1).Address.DeleteEnd WithActiveSheet.Range(raddress).SelectApplication.ScreenUpdating = TrueEnd Sub▲调整选中对象中的文字返回Sub 调整选中对象中的文字()'文字居中、自动调整大小With Selection.HorizontalAlignment = xlCenter.VerticalAlignment = xlCenter.ReadingOrder = xlContext.Orientation = xlHorizontal.AutoSize = True.AddIndent = FalseEnd WithEnd Sub▲去除指定范围内的对象返回Sub 去除指定范围内的对象()。

1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。

温馨提示：代码栏中的“12345678”是保护文档的密码，大家可以自由设置密码，可以替换。

其余的代码请不要改变。

如果不想保护公式了，可以通过“取消保护工作表”来实现，密码就是你设置的密码（若未改变则为12345678），然后公式就可以自由修改了。

本文为原创，大家可以自由使用，但谢绝转载。

作者：有风吹过20xx.4.16篇二：excel常用宏编程的代码学习excel常用宏编程的代码学习用过Vb的人都应该知道如何声明变量，在Vba中声明变量和Vb中是完全一样的！使用dim语句dimaasinteger声明a为整型变量dima声明a为变体变量dimaasstring声明a为字符串变量dimaascurrency,bascurrency,cascurrency声明a,b,c 为货币变量......声明变量可以是：byte、boolean、integer、long、currency、single、double、decimal（当前不支持）、date、string（只限变长字符串）、string*length（定长字符串）、object、Variant、用户定义类型或对象类型。

强制声明变量optionexplicit说明：该语句必在任何过程之前出现在模块中。

声明常数用来代替文字值。

const常数的默认状态是private。

constmy=456声明public常数。

publicconstmystring="help"声明privateinteger常数。

privateconstmyintasinteger=5在同一行里声明多个常数。

constmystr="hello",mydoubleasdouble=3.4567选择当前单元格所在区域在excel97中，有一个十分好的功能，他就是把鼠标放置在一个有效数据单元格中，执行该段代码，你就可以将连在一起的一片数据全部选中。

只要将该段代码加入到你的模块中。

submy_selectselection.currentRegion.selectendsub返回当前单元格中数据删除前后空格后的值submy_trimmsgboxtrim(activecell.Value)endsub单元格位移submy_offsetactivecell.offset(0,1).select当前单元格向左移动一格activecell.offset(0,-1).select当前单元格向右移动一格activecell.offset(1,0).select当前单元格向下移动一格activecell.offset(-1,0).select当前单元格向上移动一格endsub如果上述程序产生错误那是因为单元格不能移动，为了解除上述错误，我们可以往submy_offset之下加一段代码onerrorresumenext注意以下代码都不再添加sub“代码名称”和endsub请自己添加!给当前单元格赋值activecell.Value="你好！！！"给指定单元格赋值例如：Ａ１单元格内容设为"ＨＥＬＬＯ"Range("a1").value="hello"又如：你现在的工作簿在sheet1上，你要往sheet2的Ａ１单元格中插入"ＨＥＬＬＯ"1.sheets("sheet2").selectrange("a1").value="hello"或2.sheets("sheet1").Range("a1").Value="hello"说明：1.sheet2被选中，然后在将“hello"赋到a1单元格中。

2.sheet2不必被选中，即可“hello"赋到sheet2的a1单元格中。

隐藏工作表隐藏sheet1这张工作表sheets("sheet1").Visible=False显示sheet1这张工作表sheets("sheet1").Visible=true打印预览有时候我们想把所有的excel中的sheet都打印预览，请使用该段代码，它将在你现有的工作簿中循环，直到最后一个工作簿结束循环预览。

dimmyasworksheetForeachmyinworksheetsmy.printpreviewnextmy得到当前单元格的地址msgboxactivecell.address得到当前日期及时间msgboxdate删除所有文字、批注、格式返回选定区域的行数msgboxselection.Rows.count返回选定区域的列数msgboxselection.columns.count返回选定区域的地址selection.address忽略所有的错误oneRRoRResumenext遇错跳转onerrorgotoerr_handle中间的其他代码err_handle:标签跳转后的代码删除一个文件kill"c:\1.txt"定制自己的状态栏application.statusbar="现在时刻:"&time 恢复自己的状态栏application.statusbar=false用代码执行一个宏application.Runmacro:="text"滚动窗口到a1的位置activewindow.scrollRow=1activewindow.scrollcolumn=1定制系统日期dimmydate,mydaymydate=#12/12/69#myday=day(mydate)返回当天的时间dimmydate,myyearmydate=datemyyear=year(mydate)msgboxmyyearinputboxxx=inputbox("enternumberofmonthstoadd")得到一个文件名dimkkasstringkk=application.getopenFilename("excel(*.xls),*.xls" ,title:="提示：请打开一个excel文件：")篇三：excel宏入门教程excel宏入门教程在介绍学习Vba之前，应该花几分钟录制一个宏。

新术语：“宏”，指一系列excel能够执行的Vba语句。

以下将要录制的宏非常简单，只是改变单元格颜色。

请完成如下步骤：1)打开新工作簿，确认其他工作簿已经关闭。

2)选择a1单元格。

调出“常用”工具栏。

3)选择“工具”—“宏”—“录制新宏”。

4)输入“改变颜色”作为宏名替换默认宏名，单击确定,注意，此时状态栏中显示“录制”，特别是“停止录制”工具栏也显示出来。

替换默认宏名主要是便于分别这些宏。

★宏名最多可为255个字符，并且必须以字母开始。

其中可用的字符包括：字母、数字和下划线。

宏名中不允许出现空格。

通常用下划线代表空格。

5)选择“格式”的“单元格”，选择“图案”选项中的红色,单击“确定”。

6)单击“停止录制”工具栏按钮，结束宏录制过程。

※如果“停止录制”工具栏开始并未出现，请选择“工具”—“宏”—“停止录制”。

录制完一个宏后就可以执行它了。

1.4执行宏当执行一个宏时，excel按照宏语句执行的情况就像Vba代码在对excel进行“遥控”。

但Vba的“遥控”不仅能使操作变得简便，还能使你获得一些使用excel标准命令所无法实现的功能。

而且，一旦熟悉了excel的“遥控”，你都会奇怪自己在没有这些“遥控”的情况下，到底是怎么熬过来的。

要执行刚才录制的宏，可以按以下步骤进行：1）选择任何一个单元格，比如a3。

2）选择“工具”—“宏”—“宏”，显示“宏”对话框。

3）选择“改变颜色”，选择“执行”，则a3单元格的颜色变为红色。

试着选择其它单元格和几个单元格组成的区域，然后再执行宏，以便加深印象。

1.5查看录制的代码到底是什么在控制excel的运行呢你可能有些疑惑.好,让我们看看Vba的语句吧.1）选择“工具”—“宏”—“宏”，显示“宏”对话框。