excel宏技巧

MySheet.Range(″A2″).value = 200 3．在循环中要尽量减少对象的访问。 For k = 1 To 1000

Sheets(″Sheet1″).Select

Cells(k,1).value = Cells(1,1).value Next k

则以下代码比上面的要快： Set Thevalue = Cells(1,1).value Sheets(″Sheet1″).Select For k = 1 To 1000

Cells(k,1).value = Thevalue Next k

方法3：减少对象的激活和选择 数情况下这些操作不是必需的。例如 Sheets(″Sheet3″).Select Range(″A1″).value = 100 Range(″A2″).value = 200 可改为：

With Sheets(″Sheet3″) .Range(″A1″).value = 100 .Range(″A2″).value = 200 End With

方法4：关闭屏幕更新

如果你的通过录制宏来学习VBA的，则你的VBA程序里一定充满了对象的激活和选择，例如Workbooks(XXX).Activate、Shee

如果你的VBA程序前面三条做得比较差，则关闭屏幕更新是提高VBA程序运行速度的最有效的方法，缩短运行时间2/3左右。 Application.ScreenUpdate = False

请不要忘记VBA程序运行结束时再将该值设回来： Application.ScreenUpdate = True

以上是提高VBA运行效率的比较有效的几种方法 本示例重复最近用户界面命令。本示例必须放在宏的第一行。 Application.Repeat

下例中，变量 counter 代替了行号。此过程将在单元格区域 C1:C20 中循环，将所有绝对值小于 0.01 的数字都设置为 0（零）Sub RoundToZero1() For Counter = 1 To 20

Set curCell = Worksheets(\ If Abs(curCell.Value) < 0.01 Then curCell.Value = 0 Next Counter End Sub

述过程在单元格区域 A1:D10 中循环，将所有绝对值小于 0.01 的数字都设置为 0（零）。 Sub RoundToZero2()

For Each c In Worksheets(\ If Abs(c.Value) < 0.01 Then c.Value = 0 Next End Sub

下述过程在工作表上运行时，将在活动单元格周围的区域内循环，将所有绝对值小于 0.01 的数字都设置为 0（零）。 Sub RoundToZero3()

For Each c In ActiveCell.CurrentRegion.Cells If Abs(c.Value) < 0.01 Then c.Value = 0 Next End Sub

下述过程在工作的空行写入数据 Sub 输入()

x = 3 '从第3行开始

Do While Not (IsEmpty(Cells(x, 2).Value)) '判断第2列的最后一行(即空行的上一行) x = x + 1 '在最后一行加一行即为空行 Loop

'以下为写入数据

Cells(x, 1) = Sheets(\Cells(x, 2) = Sheets(\Cells(x, 3) = Sheets(\Cells(x, 4) = Sheets(\Sheets(\

Cells(2, 3) = Cells(2, 3) + 1 '每写一行自动加入序列号 Sheets(\End Sub Sub 每日结帐() ' 录入发生额 Macro

' 30 记录的宏 2002-12-18

Application.ScreenUpdating = False '关闭屏幕显示

If Application.InputBox(\请输入密码：\ '此行与倒数3-5行设置密码 Dim Msg, Style, Title, X, MyString '设置变量 Msg = \！！！结帐后不能恢复，结帐吗？\ ' 定义信息。

Style = vbYesNo + vbCritical + vbDefaultButton2 ' 定义按钮。 Title = \本日结帐！\ ' 定义标题。 X = MsgBox(Msg, Style, Title)

If X = vbYes Then ' 用户按下“是”。 Close Call 备份 Call 重算所有表 Sheets(\日报表\ ActiveSheet.Unprotect

Selection.AutoFilter Field:=1 '全部显示 Sheets(\余额表\ ActiveSheet.Unprotect

Selection.AutoFilter Field:=1 '全部显示 Range(\ Sheets(\日报表\ Range(\

Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _ , AllowSorting:=True, AllowFiltering:=True [A2].Copy

Sheets(\银行帐\ Range(\

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _ , AllowSorting:=True, AllowFiltering:=True Application.CutCopyMode = False End If

Else: MsgBox \密码错误，即将退出！\ '此行与第2行共同设置密码 End If

Application.ScreenUpdating = True '打开屏幕显示 End Sub Sub 月末结帐()

Application.ScreenUpdating = False

If Application.InputBox(\请输入密码：\ '此行与倒数3-5行设置密码 '以下三行为消息框

Dim Msg, Style, Title, X, MyString

Msg = \！！！结帐后不能恢复，结帐吗？\ ' 定义信息。

Style = vbYesNo + vbCritical + vbDefaultButton2 ' 定义按钮。 Title = \月末结帐！\ ' 定义标题。 X = MsgBox(Msg, Style, Title)

If X = vbYes Then ' 用户按下“是”。 Close Call 备份 Call 重算所有表

Sheets(\余额表\ [L6:L183].Copy

Sheets(\日报表\ Range(\

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range(\ [N6:S183] = \ Sheets(\银行帐\ [A7:u3000] = \ [K5].Copy Range(\

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False

Application.CutCopyMode = False Range(\End If

Else: MsgBox \密码错误，即将退出！\ '此行与第2行共同设置密码 End If

Application.ScreenUpdating = True End Sub Sub 打日报表()

Application.ScreenUpdating = False Sheets(\日报表\ Call 重算所有表

ActiveSheet.Unprotect Password:=641112 '撤消工作表保护并取消密码 Selection.AutoFilter Field:=1, Criteria1:=\ '自动筛选

'以下10行弹出窗口输入打印信息 Dim myPrintNum As Integer Dim myPrompt, myTitle As String myPrompt = \请输入要打印的份数\ myTitle = \打印选取范围\

myPrintNum = Application.InputBox(myPrompt, myTitle, 4, , , , , 1) If myPrintNum <> 0 Then

' Application.ActivePrinter = \在 Ne00:\ ActiveWindow.SelectedSheets.PrintOut Copies:=myPrintNum, Collate:=True Else

MsgBox \请输入要打印的份数\ End If

ActiveSheet.ShowAllData '全部显示

ActiveSheet.Protect Password:=641112 ' 保护工作表并设置密码 Sheets(\封面\

Application.ScreenUpdating = True End Sub Sub 打印余额()

Application.ScreenUpdating = False Sheets(\余额表\ Call 重算所有表

ActiveSheet.Unprotect Password:=641112 '撤消工作表保护并取消密码 ActiveWindow.ScrollColumn = 10

Selection.AutoFilter Field:=1, Criteria1:=\ '以下10行弹出窗口输入打印信息 Dim myPrintNum As Integer Dim myPrompt, myTitle As String myPrompt = \请输入要打印的份数\ myTitle = \打印选取范围\

myPrintNum = Application.InputBox(myPrompt, myTitle, 4, , , , , 1)

'指定打印机 '设置打印信息,其中Copies:=myP