vba常用代码大全

合集下载

excel vba常用代码

excel 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单元格的字体为粗体、背景色为红色、边框为实线。

VBA常用代码大全

VBA常用代码大全

.、八、-刖言我们平时在工作表单元格的公式中常常使用函数,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常用代码

VBA常用代码

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代码

常⽤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 常用宏代码

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

(完整word)VBA代码全集

(完整word)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(”类款项")。

vba常用代码大全

vba常用代码大全

前言我们平时在工作表单元格的公式中常常使用函数,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。

EXCELWPS VBA宏代码大全

EXCELWPS VBA宏代码大全

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例子程序

100个vba例子程序

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

Excel VBA代码 亲测可用

Excel VBA代码 亲测可用

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。

(word完整版)VBA代码汇总,推荐文档

(word完整版)VBA代码汇总,推荐文档

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经典代码

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

VBA常用代码

VBA常用代码

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,递减。

VBA代码汇总

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.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代码汇总范文

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代码示例,可以根据具体需求进行修改和扩展。

EXCELVBA常用代码集

EXCELVBA常用代码集

EXCELVBA常用代码集1.显示活动工作簿名称MsgBox "当前活动工作簿是" & 2.保存活动工作簿Activeworkbook.Save3.保存所有打开的工作簿关闭EXCELFor Each W in Application.WorkbooksW.SaveNext WApplication.Quit4.将网格线设置为蓝色ActiveWindow.GridlineColorIndex = 55.将工作表sheet1隐藏Sheet1.Visible = xlSheetVeryHidden6.将工作表Shtte1显示Sheet1.Visible = xlSheetVisible7.单击某单元格,该单元格所在的行以蓝色背景填充,字体颜色为白色Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)If Target.Row >= 2 Then’第二行以下的区域On Error Resume Next[ChangColor_With1].FormatConditions.Delete = "ChangColor_With1"With [ChangColor_With1].FormatConditions.Delete.Add xlExpression, , "TRUE".Item(1).Interior.ColorIndex = 5.Item(1).Font.ColorIndex = 2End WithEnd IfEnd Sub8.使窗体在启动的时候自动最大化Private Sub UserForm_Initialize()Application.WindowState = xlMaximizedWith ApplicationMe.Top = .TopMe.Left = .LeftMe.Height = .HeightMe.Width = .WidthEnd WithEnd Sub9.不保存工作簿退出EXCELApplication.DisplayAlerts = FalseApplication.Quit10.使窗体的关闭按纽不好用Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)If CloseMode = vbformcontrdmenu ThenMsgBox "请用关闭按钮关闭窗口!!", 64, "提示"Cancel = TrueEnd IfEnd Sub11.使窗体在3秒后自动关闭Private Sub UserForm_Activate()Application.Wait Now + TimeValue("00:00:03")UserForm1.HideEnd Sub12.启动窗体的时候自动使Label1显示Sheet1工作表3列,8行的内容Private Sub UserForm_Activate()Label1.Caption = Sheets("sheet1").Cells(3, 8)End Sub13.让按纽CommandButton1在窗体上以不可用状态显示CommandButton1.Enabled = False14.让按纽Commandbutton1在窗体上以隐藏方式存在CommandButton10.Visible = False15.点击Commandbutton1按纽进入”工资”工作表Sheets("工资").Select16.在Textbox1中输入数据,窗体可显示出”工资”工作表中与输入内容关联的项Private Sub TextBox1_Change()For X = 1 To Application.CountA(Sheets("工资").Range("a:a")) If Sheets("工资").Cells(X, 1) = TextBox1.Text Then’在工资表第一列查找与Textbox1输入相符的项Label2.Caption = Sheets("工资").Cells(X, 2)’在Label2中显示Textbox1数据所在的第二列的数据Label7.Caption = Sheets("工资").Cells(X, 3)’在Label2中显示Textbox1数据所在的第三列的数据End IfNextEnd Sub17.使EXCEL启动的时候自动最小化/最大化Private Sub Workbook_Open()Application.WindowState = xlMinimized’最小化Application.WindowState = xlMaximized’最大化End Sub18.在Label25以数字的形式显示TextBox12×Label14的结果Label25.Caption = Val(TextBox12.Text) * Val(Label14.Caption)19.单选按纽名与Sheet6工作表名相同OptionButton6.Caption = 20.”登陆”窗体的显示,隐藏登陆.Show’显示登陆.Hide’隐藏21.使窗体的标题栏不显示(1)插入类模块” CFormChanger”代码如下:Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPrivate Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As LongPrivate Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPrivate Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As LongPrivate Const GWL_STYLE As Long = (-16)Private Const WS_CAPTION As Long = &HC00000Dim hWndForm As Long……………………………………………………………………………………………………………..Public Property Set Form(oForm As Object) '29If Val(Application.Version) < 9 ThenhWndForm = FindWindow("ThunderXFrame", oForm.Caption)ElsehWndForm = FindWindow("ThunderDFrame", oForm.Caption)End IfSetFormStyleEnd Property……………………………………………………………………………………………………………….Private Sub SetFormStyle()Dim iStyle As Long, hMenu As Long, hID As Long, iItems As IntegeriStyle = GetWindowLong(hWndForm, GWL_STYLE)iStyle = iStyle And Not WS_CAPTIONiStyle = iStyle Or WS_THICKFRAMESetWindowLong hWndForm, GWL_STYLE, iStyleDrawMenuBar hWndFormEnd Sub(2)在所在窗体代码里声明Dim oFormChanger As New CFormChanger(3).在窗体的Activate事件中插入代码Set oFormChanger.Form = MeMe.SpecialEffect = fmspecia1EffectRaised以上三步每一步都不可缺少,否则不能完成.22.单击某单元格,该单元格所在的行与列都以蓝色背景填充Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)If Target.Row >= 2 Then’第二行以下的所有列On Error Resume Next[ChangColor_With2].FormatConditions.Delete[ChangColor_With3].FormatConditions.Delete = "ChangColor_With2" = "ChangColor_With3"With [ChangColor_With2].FormatConditions.Delete.Add xlExpression, , "TRUE".Item(1).Interior.ColorIndex = 5End WithWith [ChangColor_With3].FormatConditions.Delete.Add xlExpression, , "TRUE".Item(1).Interior.ColorIndex = 5End WithEnd IfEnd Sub23.显示动态时间(1)插入窗体Userform1及Label1并在窗体声明中插入Option ExplicitPublic nextRun As Date(2)在窗体Activate事件中插入Showtime(3)在窗体QueryClose事件中插入Application.OnTime nextRun, "showtime", schedule:=False (4)插入模块Module1并输入Option ExplicitSub showtime()bel1 = NowUserForm1.RepaintDoEventsUserForm1.nextRun = Now + 1 / 86400Application.OnTime UserForm1.nextRun, "showtime" End Sub24.加载Combobox1选项ComboBox1.AddItem "收入型"ComboBox1.Additem “支出型”25.使Textbox1自动程输入状态显示(有光标闪动)TextBox1.SetFocus26.打开C盘目录Shell "explorer.exe C:\", 1。

VBA编程中的常用代码

VBA编程中的常用代码

VBA编程中的常用代码VBA(Visual Basic for Applications)是一种编程语言,用于在Microsoft Office应用程序中编写自定义宏和功能。

以下是一些在VBA 编程中常常用到的代码片段和技巧。

1. Excel VBA:打开和关闭工作簿这段代码演示了如何在Excel VBA中打开和关闭一个工作簿。

```vbaSub OpenAndCloseWorkbookDim wb As WorkbookSet wb = Workbooks.Open("C:\Path\To\Your\File.xlsx")'在这里执行你的代码wb.Close SaveChanges:=FalseEnd Sub```2. Excel VBA:遍历工作表下面的代码展示了如何遍历一个Excel工作簿中的所有工作表。

```vbaSub LoopThroughWorksheetsDim ws As WorksheetFor Each ws In ThisWorkbook.Worksheets'在这里执行你的代码Next wsEnd Sub```3. Excel VBA:在工作表中查找特定值以下代码展示了如何在一个工作表中查找特定值并返回它的位置。

```vbaFunction FindValue(ByRef rng As Range, ByVal searchValue As String) As RangeDim cell As RangeSet FindValue = NothingFor Each cell In rngIf cell.Value = searchValue ThenSet FindValue = cellExit FunctionEnd IfNext cellEnd Function```4. Word VBA:插入文本以下代码演示了如何在Word文档中插入文本。

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

前言我们平时在工作表单元格的公式中常常使用函数,Excel自带的常用的函数多达300多个,功能强大,丰富多彩,但是在VBA中不能直接应用,必须在函数名前面加上对象,比如:,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。

这里返回小写字母e 的ASCII代码101。

5、[a1] = "myNum1= ": [b1] = myNum1:把字符串“myNum1= “赋给A1单元格,把变量myNum1的值赋给B1单元格。

6、[a2] = "myNum2= ": [b2] = myNum2:把字符串“myNum2= “赋给A2单元格,把变量myNum2的值赋给B2单元格。

7、End Sub:程序的结束语句,和“Sub示例_1_01()”相对应。

第1.2例 Chr函数一、题目"":要求编写一段代码,运用Chr函数将ASCII值转换为对应的字符。

二、代码:Sub 示例_1_02()Dim myChar1$, myChar2$myChar1 = Chr(69) ' 返回 E。

myChar2 = Chr(101) ' 返回 e。

[a1] = "myChar1= ": [b1] = myChar1[a2] = "myChar2= ": [b2] = myChar2End Sub三、代码详解1、Sub 示例_1_02():宏程序的开始语句。

2、Dim myChar1$, myChar2$:变量myChar1和myChar2声明为字符串变量。

也可以写为 Dim myChar1 As String 。

String 之字符码的范围是 0 到 255。

字符集的前 128 个字符(0 到 127)对应于标准的 U.S. 键盘上的字符与符号。

这前 128 个字符与 ASCII字符集中所定义的相同。

后 128 个字符(128 到 255)则代表特殊字符,例如国际字符,重音符号,货币符号及分数。

String 的类型声明字符为美元号 ($)。

3、myChar1 = Chr(69):把Chr(69)的值赋给变量myChar1。

这里返回大写字母E。

Chr函数根据字符代码返回一个字符。

语法Chr(charcode)必要的 charcode(字符代码)参数是用来识别某字符的。

4、myChar2 = Chr(101):把Chr 函数的值赋给变量myChar2。

这里返回小写字母e。

5、[a1] = "myChar1= ": [b1] = myChar1:把字符串“myChar1= “赋给A1单元格,把变量myChar1的值赋给B1单元格。

6、[a2] = "myChar2= ": [b2] = myChar2:把字符串“myChar2= “赋给A2单元格,把变量myChar2的值赋给B2单元格。

7、End Sub:程序的结束语句,和“Sub示例_1_02()”相对应。

第1.3例 Choose函数一、题目:要求编写一段代码,运用Choose函数根据指定数字选择对应的字符串。

二、代码:Sub 示例_1_03()Dim Num%Num=2MsgBox Choose(Num, "一月", "二月", "三月")End Sub三、代码详解1、Sub 示例_1_03():宏程序的开始语句。

宏名为示例_1_03。

2、Dim Num% :变量Num声明为整型变量。

3、Num=2 :把2赋给变量Num。

4、MsgBox Choose(Num, "一月", "二月", "三月") :Choose函数从参数列表中选择并返回一个值。

语法Choose(index, choice-1[, choice-2, ... [, choice-n]])Choose 会根据 index 的值来返回选择项列表中的某个值。

如果 index 是 1,则 Choose会返回列表中的第 1 个选择项。

如果 index 是 2,则会返回列表中的第 2 个选择项,以此类推。

Index是必要参数,数值表达式或字段,它的运算结果是一个数值,且界于 1 和可选择的项目数之间。

当 index小于 1 或大于列出的选择项数目时,Choose 函数返回 Null。

如果 index 不是整数,则会先四舍五入为与其最接近的整数。

第1.4例 Cos函数一、题目:要求编写一段代码,运用Cos函数根据指定角度的余弦计算其正割的值。

二、代码:Sub 示例_1_04()Dim jiaodu, zengejiaodu = 1.3zenge = 1 / Cos(jiaodu)MsgBox “角度为” & jiaodu & “的正割的值=” & zengeEnd Sub三、代码详解1、Sub 示例_1_04():宏程序的开始语句。

宏名为示例_1_04。

2、Dim jiaodu, zenge :两个变量都被指定为可变型数据类型。

当声明常数、变量或参数时,若无指定数据类型则会自动的指定成 Variant(可变型)数据类型。

声明成 Variant 数据类型的变量可以为字符串、日期、时间、Boolean或数值。

3、jiaodu = 1.3 :把以“弧度”为单位的角度1.3赋给变量jiaodu。

4、zenge = 1 / Cos(jiaodu) :利用1/余弦算得正割(sec())的值,赋给变量zenge。

Cos函数返回一个角的余弦值。

其参数是表示一个以弧度为单位的角。

5、MsgBox “角度为” & jiaodu & “的正割的值=” & zenge :利用MsgBox函数显示算得的正割(sec())的值。

第1.5例 Date函数一、题目:要求编写一段代码,运用Date函数显示系统日期的值。

二、代码:Sub 示例_1_05()Dim myDatemyDate = DateMsgBox “系统日期为” & myDateEnd Sub三、代码详解1、Sub 示例_1_05():宏程序的开始语句。

宏名为示例_1_05。

2、Dim myDate :变量myDate被指定为可变型数据类型。

3、myDate = Date :把系统日期的值赋给变量myDate。

Date函数返回系统当前的日期。

4、MsgBox “系统日期为” & myDate :利用MsgBox函数显示系统日期的值。

第1.6例 DateAdd函数一、题目:要求编写一段代码,运用DateAdd函数显示返回一定间隔后的日期。

二、代码:Sub 示例_1_06()Dim dyrq As DateDim jglx As StringDim n As IntegerDim Msgjglx = "m"dyrq = InputBox("请输入一个日期")n = InputBox("输入增加月的数目:")Msg = "新日期: " & DateAdd(jglx, n, dyrq)MsgBox MsgEnd Sub三、代码详解1、Sub 示例_1_06():宏程序的开始语句。

宏名为示例_1_06。

2、Dim dyrq As Date :变量dyrq声明为日期对象型数据类型。

其余几个变量分别是字符串型、整型和可变型变量。

3、jglx = "m" :用字符m来指定以“月份”作为间隔。

4、dyrq = InputBox("请输入一个日期") :用InputBox函数来让用户输入一个日期,并把用户输入的日期赋给变量dyrq。

5、n = InputBox("输入增加月的数目:") :用InputBox函数来让用户输入间隔月的数目,并把用户输入的值赋给变量n。

6、Msg = "新日期: " & DateAdd(jglx, n, dyrq) :用DateAdd函数计算得到的新的日期和字符串“新日期:”连接起来赋给变量Msg。

DateAdd函数返回一个日期,这一日期加上了一个时间间隔。

语法DateAdd(interval, number, date)DateAdd 函数语法中有下列命名参数:interval 必要。

字符串表达式,是所要加上去的时间间隔。

它具有好多设定值,比如”m”为月;”d”为日;”yyyy”为年等等。

number 必要。

数值表达式,是要加上的时间间隔的数目。

其数值可以为正数(得到未来的日期),也可以为负数(得到过去的日期)。

date 必要。

表示日期的文字。

7、MsgBox Msg :利用MsgBox函数显示Msg的值。

第1.7例 DateDiff函数一、题目:要求编写一段代码,运用DateDiff函数返回某个指定日期距离今天的天数。

相关文档
最新文档