|
Private Sub Worksheet_Calculate() Columns("A:F").AutoFit End Sub 本示例向活动工作簿添加新工作表，并设置该工作表的名称。 Set newSheet = Worksheets.Add newSheet.Name = "current Budget" 本示例关闭工作簿 Book1.xls，但不提示用户保存所作更改。Book1.xls 中的所有 更改都不会保存。 Application.DisplayAlerts = False Workbooks("BOOK1.XLS").Close Application.DisplayAlerts = True 示例显示每一个可用加载宏的路径及文件名。 For Each a In AddIns MsgBox a.FullName Next a ChDir 语句 改变当前的目录或文件夹。 ChDir path 在 Power Macintosh 中，默认驱动器总是改为在 path 语句中指定的驱动器。完整 路径指定由卷标名开始，相对路径由冒号 (:) 开始. ChDir 可以辨认路径中指定的 别名: ChDir "MacDrive:Tmp" ' 在 Macintosh 中 本示例显示当前路径分隔符。 MsgBox "The path separator character is " & _ Application.PathSeparator Move 方法 将一个指定的文件或文件夹从一个地方移动到另一个地方。 语法 object.Move destination Move 方法语法有如下几部分： 部分 描述 object 必需的。始终是一个 File 或 Folder 对象的名字。 destination 必需的。文件或文件夹要移动到的目标。不允许有通配符。 CreateFolder 方法 创建一个文件夹。 语法 object.CreateFolder(foldername) reateFolder 方法有如下几部分： 部分 描述 object 必需的。始终是一个 FileSystemObject 的名字。 foldername 必需的。字符串表达式，它标识创建的文件夹。 本示例使用 MkDir 语句来创建目录或文件夹。如果没有指定驱动器，新目录或文件 夹将会建在当前驱动器中。 MkDir "MYDIR" ' 建立新的目录或文件夹。 Name 语句示例 本示例使用 Name 语句来更改文件的名称。示例中假设所有使用到的目录或文件夹都 已存在。 在 Macintosh 中，默认驱动器名称是 “HD” 并且路径部分由冒号取代 反斜线隔开。 Dim OldName, NewName OldName = "OLDFILE": NewName = "NEWFILE" ' 定义文件名。 Name OldName As NewName ' 更改文件名。 OldName = "C:\MYDIR\OLDFILE": NewName = "C:\YOURDIR\NEWFILE" Name OldName As NewName ' 更改文件名，并移动文件。 本示例设置替换启动文件夹。 Application.AltStartupPath = "C:\EXCEL\MACROS" FolderExists 方法 如果指定的文件夹存在返回 True，不存在返回 False。 语法 object.FolderExists(folderspec) 本示例在单元格中启用编辑。 Application.EditDirectlyInCell = True 程序说明： 几种用VBA在单元格输入数据的方法： Public Sub Writes() 1-- 2 方法，最简单在 "[ ]" 中输入单元格名称。 1 [A1] = 100 '在 A1 单元格输入100。 2 [A2:A4] = 10 '在 A2:A4 单元格输入10。 3-- 4 方法，采用 Range(" ")， " " 中输入单元格名称。 3 Range("B1") = 200 '在 B1 单元格输入200。 4 Range("C1:C3") = 300 '在 C1:C3 单元格输入300。 5-- 6 方法，采用 Cells(Row,Column)，Row是单元格行数，Column是单元格栏数。 5 Cells(1, 4) = 400 '在 D1 单元格输入400。 6 Range(Cells(1, 5), Cells(5, 5)) = 50 '在 E1:E 5单元格输入50。 End Sub VBALesson3 程序说明： 如何利用 Worksheet_SelectionChange 输入数据的方法。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) Target = 100 End Sub VBALesson4 程序说明： 如何利用 Worksheet_SelectionChange 在限定的单元格输入数据的方法。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Row >= 2 And Target.Column = 2 Then Target = 100 End If End Sub VBALesson5 程序说明： 比较 Worksheet_SelectionChange() 与用按钮 CommandButton1_Click() 来执行 程序二者的方法与写法有何不同。 Worksheet_SelectionChange()事件 Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Row >= 2 And Target.Column = 2 Then Target = 100 End If End Sub 按鈕 CommandButton1_Click() Private Sub CommandButton1_Click() If ActiveCell.Row >= 2 And ActiveCell.Column >= 3 Then ActiveCell = 100 End If End Sub 二者执行方法最大的地方，在于 Worksheet_SelectionChange() 是自动的，你不用 了解他是怎么完成工作的。 按钮 CommandButton1_Click() 是人工的，比 SelectionChange()多一道手续， 就是要去按那接钮，程序才会执行。 SelectionChange() 有一个参数 Target 可用；CommandButton1_Click ()没有。 所以我们要用 ActiveCell 内定函数来取代Target，ActiveCell 与 Target最大的 不同点他只能指定一个单元格。 就是你选取多个单元格也只有最上面的单元格会加上数据；用 Selection 取代 ActiveCell， 用法就跟 Target 一样了。 VBALesson 6 程序说明： 完整的 If...Then ┅ End 逻辑判断式。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Row >= 2 And Target.Column = 2 Then Target = 200 ElseIf Target.Row >= 2 And Target.Column = 3 Then Target = 300 ElseIf Target.Row >= 2 And Target.Column = 2 Then Target = 400 Else Target = 500 End If End Sub 这是个完整的 If 逻辑判断式，意思是说，假如 If 後的判断式条件成立的话，就 执行第二条程序，否则假如 ElseIf 後的判断式条件成立的话，就执行第四条程序 ，否则假如另一个 ElseIf 後的判断式条件成立的话，就执行第六条程序。 Else 的意思是说，假如以上条件都不成立的话，就执行第八条程序。 他的执行方式是假如 IF 的条件成立的话，就不执行其它ElseIf 及Else 的逻辑判 断式，假如 If 後的条件不成立的话才会执行 ElseIf 或 Else 逻辑判断式。第二 个 ElseIf後的条件因为与 IF 後的条件一样，所以这个判断式後面的 Target=400 将是永远无法执行到的程序。 VBALesson 7 程序说明∶我们为什麽要用变数。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim i , j As Integer Dim k As Range i = Target.Row j = Target.Column Set k = Target If i >= 2 And j = 2 Then k = 200 ElseIf i >= 2 And j = 3 Then k = 300 ElseIf i >= 2 And j = 4 Then k = 400 Else k = 500 End If End Sub Private Sub Worksheet_Change(ByVal Target As Range) Dim iRow, iCol As Integer iRow = Target.Row iCol = Target.Column If iRow >= 2 And iCol = 2 And Target "" Then Application.EnableEvents = False Cells(iRow, iCol + 1) = Cells(iRow, iCol) * 2 Application.EnableEvents = True ElseIf iRow >= 2 And iCol = 2 And Target = "" Then Cells(iRow, iCol + 1) = "" Else Cells(iRow, iCol + 1) = "" End If End Sub 前几个教程都是用Worksheet_SelectionChange 事件来举例子，大家应该能体会他 是怎厶一回事了吧。 这个教程就是要让你来体会什厶是Worksheet_Chang()事件。因为这二个事件在VBA 都是非常有用的，所以一定要了解。 简单的说，前者是你鼠标移动到那个单元格，就触发那个事件的执行。後者是要等到 你点选的单元格，数?有了改变才会触发事件的执行。二者执行的时机一前一後。 Target "" 是代表限定当前的单元格要是有数?的，才会执行以下三行的程序。 Cells(iRow, iCol + 1) = Cells(iRow, iCol) * 2，是你在 B 栏输入数?时，C 栏将可得到 B 栏二倍的数?。 Target = "" 是限定当前的单元格要是没有数?的，才会执行以下一行的程序。 Cells(iRow, iCol + 1) = ""，是把 C 栏的数?清成空格。 Application.EnableEvents = False与Application.EnableEvents = True，这是 个成双的程序，当你用了前者记得在执行其他程序後要写上後面的程序。它的目的在 抑制事件连锁执行。简单的说就是，在 B 字段所触发的事件，不愿在其它单元格再 触发另一个Worksheet_Change()事件。 VBALesson 9 程序说明∶体会一下Worksheet_Change()事件连锁反应。 Private Sub Worksheet_Change(ByVal Target As Range) Dim iRow As Integer iRow = Target.Row Application.EnableEvents = False Cells(iRow, 3) = Cells(iRow, 3) + Cells(iRow, 2) Application.EnableEvents = True End Sub Private Sub Worksheet_Change(ByVal Target As Range) Dim iRow As Integer iRow = Target.Row 'Application.EnableEvents = False Cells(iRow, 3) = Cells(iRow, 3) + Cells(iRow, 2) 'Application.EnableEvents = True End Sub 这个程序的目的是要在 B2 输入新的数?时，C2 会将 B2 输入的新数?加上 C2 原 有的数?呈现在 C2 上。 照上面有加上 Application.EnableEvents = False 程序执行当然没问题。 现在你在 Application.EnableEvents = False 与 Application.EnableEvents = True 前加上「 '」看看。 程序前加上「 '」的目的是要使「 '」之后的文字变成说明文字，程序执行时是会跳 过说明文字，不执行说明文字的内容。 程序前加上「 '」符号后，文字会变成绿色。 执行第二个程序时，你将发现 C2 不会按你所要求的，呈现结果。 这就是所谓的事件连锁反应。 请问这个宏该如何写! 我想运行一个宏,就能在当前工作表B3上填上一条公式;这条公式的结果是所有工作 表上的B4单元格的和.请问这个宏该如何写.谢谢! Sub gg() Dim sh As Worksheet, shname$ For Each sh In Worksheets shname = sh.Name ActiveSheet.Range("b3").value = ActiveSheet.Range("b3").value + Worksheets(shname).Range("b4") Next End Sub VBA中怎样创建一个名为“table”的新工作表 通过VBA编程，很容易添加新的工作表，但是新表的名字不知怎样控制，对于新创建 的工作表，由于其名字并非特定，所以就不好使用所创建的新表了。不知各位有何高 见。。。。 Sheets.Add ActiveSheet.Name = "table" 请教：如何用VBA检索表1中A列与表2，3，4，5.....中A列相同的行并把后者整行拷 贝到表1检索到的行中,谢谢!!!! To yxptwq∶用这程序试看看。 Sub Copy1() Dim Row_dn1, Row_dnN, i, j, n As Integer Row_dn1 = Sheet1.Range("A65536").End(xlUp).Row k = 1: n = 1 For Each wSheet In ActiveWorkbook.Worksheets If .Name "Sheet1" Then Row_dnN = .Range("A65536").End(xlUp).Row For i = 2 To Row_dn1 For j = 2 To Row_dnN If .Cells(j, 1) = Sheet1.Cells(i, 1) Then .Rows(j & ":" & j).Copy Destination:=Sheet1.Rows(Row_dn1 + n & ":" & Row_dn1 + n) n = n + 1 End If Next j Next i End If End With Next wSheet End Sub 如果要用VBA程式输入密码使用下列程式码 Sub EnterNewPW() '程式说明:利用SendKey输入VBAProject密码 '注意事项:执行本程式需要在Excel视窗,不能在VBE视窗 Application.SendKeys "%{F11}", True 'Alt + F11 切换到VBA视窗 Application.SendKeys "%T", True 'ALT + T 工具(繁体中文是(T)) Application.SendKeys "e", True '工具(T)-VBproject属性(E) Application.SendKeys "^{TAB}", True 'TAB 键(切换到PAge2 保护页面) Application.SendKeys "{+}", True '选取Checkbox方块(锁定专案以供检 视) '({+} 选取, {-} 取消选取) Application.SendKeys "{TAB}", True 'TAB 键(跳到第一次输入密码 Textbox myPW = "chijanzen" '假设密码 chijanzen Application.SendKeys myPW, True '输入密码 Application.SendKeys "{TAB}", True 'TAB 键(跳到第二次输入密码 Textbox Application.SendKeys myPW, True '输入密码 Application.SendKeys "{ENTER}", True '按确定钮(预设值) Application.SendKeys "%{F11}", True '返回Excel视窗 End Sub 冒泡排序法： 冒泡排序法之所以成为“冒泡排序”是因为值较小的或是较轻的元素浮到作为继续排 序的一组数的顶部。 Sub Macro1() Dim i As Integer Dim j As Integer Dim t as integer Static number(1 To 10) As Integer For i = 1 To 10 number(i) = inputbox“输入要排序的数：” Next i For i = 10To 2 Step -1 For j = 1 To i – 1 ‘下面进行位置交换 If number(j) > number(j + 1) Then t = number(j + 1) number(j + 1) = number(j) number(j) = t End If Next j Next i For i = 1 To 20 Print number(i) Next i End sub 首先定义一个数组：通过循环录入10个整数，然后用一个二重循环测试前一个数是否 大于后一个数。如果大于则交换两个数的下标，即交换两个数在数组中的位置，交换 通过一个变量来进行。 我先用传统的方法解决这个问题，经过比较，选用了较为简单的和高效的排序方法 ——“快速排序”，具体算法可参考数据结构等有关书籍。对所有数据排序后再合 并相同数据，合并程序较为简便，我开始时采用了这种方法，但后来发现对于这些 的数据，先合并后排序速度更快，因为有大量相同的数据。合并是采用“标记”算 法，具体如下：（设数据已存放在sData()数组中 ，结果存到Queryp()数组， Amount是数据个数） '把相同元素置 0 For i = 1 To Amount If sData(i) 0 Then For j = i ＋ 1 To Amount If sData(i) = sData(j) Then sData(j) = 0 Next j End If Next i '删除相同元素 Queryp(1) = sData(1) k = 1 For i = 2 To Amount If Not (sData(i) = 0) Then k = k ＋ 1 Queryp(k) = sData(i) End If Next i kMax = k ReDim Preserve Queryp(kMax) 虽然这样使得运算速度有所高，但是仍然要进行大量的循环运算，占据了程序大部 分的运算时间。于是我一直在寻觅一种更为高效的算法。 功夫不负有心人，在仔细分析数据的特征，比较了多种方案之后，我终于找到了一 种相当成功的算法，原来要3到4秒的运算缩短到仅需0.1到0.2秒。 我遇到的数据具有以下特征：①相同数据很多，②最大、最小数之间相差不到3， ③都是带两位小数的正数。 针对数据的特征，我采用了以下算法： 针对数据的特征，我采用了以下算法： 步骤： 1． 用一个循环找出整数和小数部分的最大、最小值。小数部分的最大、最小值乘 以100转为整数。 2． 定义一个二维数组，下标范围分别是整数和小数部分的最小值到最大值。 3． 再用一个循环把所有源数据填入刚才定义的二维数组，填写规则是，源数据的 整数和小数部分分别对应二维数组的两个下标。例如，“13.51"填到“A(13,51)" 中。 4． 最后顺向或逆向读取二维数组中的非零数据即可得到从小到大或从大到小排列 的数据，而且不会含有重复数据。 用VB 编写的程序如下： '＊＊＊＊密集型数据处理＊＊＊＊ Dim i As Long, j As Long, k As Long, kMax As Long Dim Queryp() As Single ReDim Queryp(Amount) Dim IntegerPart As Integer, DecimalPart As Integer Dim IPmax As Integer, IPmin As Integer Dim DPmax As Integer, DPmin As Integer Dim DiffDataArray() '读取数据 ReadData IPmax = 0: IPmin = 1000 DPmax = 0: DPmin = 99 For i = 1 To Amount ' 找整数和小数部分的最大、最小值 IntegerPart = Int(sData(i)) DecimalPart = (sData(i) － IntegerPart) ＊ 100 If IntegerPart > IPmax Then IPmax = IntegerPart ElseIf IntegerPart DPmax Then DPmax = DecimalPart ElseIf DecimalPart 0 Then k = k ＋ 1 Queryp(k) = DiffDataArray(i, j) |