本示例為設(shè)置工作表密碼
ActiveSheet.PRotect PassWord:=641112 ' 保護工作表并設(shè)置密碼
ActiveSheet.Unprotect Password:=641112 '撤消工作表保護并取消密碼
'本示例保存當(dāng)前活動工作簿的副本。
ActiveWorkbook.SaveCopyAs "C:/TEMP/XXXX.XLS"
'本示例通過將 Saved 屬性設(shè)為 True 來關(guān)閉包含本段代碼的工作簿，并放棄對該
工作簿的任何更改。
ThisWorkbook.Saved = True
ThisWorkbook.Close

'本示例對自動重新計算功能進行設(shè)置，使 Microsoft Excel 不對第一張工作表自
動進行重新計算。
Worksheets(1).EnableCalculation = False

'下述過程打開 C 盤上名為 MyFolder 的文件夾中的 MyBook.xls 工作簿。
Workbooks.Open ("C:/MyFolder/MyBook.xls")

'本示例顯示活動工作簿中工作表 sheet1 上單元格 A1 中的值。
MsgBox Worksheets("Sheet1").Range("A1").Value

本示例顯示活動工作簿中每個工作表的名稱
For Each ws In Worksheets
MsgBox ws.Name
Next ws

本示例向活動工作簿添加新工作表 , 并設(shè)置該工作表的名稱?
Set NewSheet = Worksheets.Add
NewSheet.Name = "current Budget"

本示例將新建的工作表移到工作簿的末尾
'Private Sub Workbook_NewSheet(ByVal Sh As Object)
Sh.Move After:=Sheets(Sheets.Count)
End Sub

本示例將新建工作表移到工作簿的末尾
'Private Sub App_WorkbookNewSheet(ByVal Wb As Workbook, _
ByVal Sh As Object)
Sh.Move After:=Wb.Sheets(Wb.Sheets.Count)
End Sub

本示例新建一張工作表，然后在第一列中列出活動工作簿中的所有工作表的名稱。
Set NewSheet = Sheets.Add(Type:=xlWorksheet)
For i = 1 To Sheets.Count
NewSheet.Cells(i, 1).Value = Sheets(i).Name
Next i

本示例將第十行移到窗口的最上面?
Worksheets("Sheet1").Activate
ActiveWindow.ScrollRow = 10

當(dāng)計算工作簿中的任何工作表時，本示例對第一張工作表的 A1:A100 區(qū)域進行排序

。
'Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
With Worksheets(1)
.Range("a1:a100").Sort Key1:=.Range("a1")
End With
End Sub
本示例顯示工作表 Sheet1 的打印預(yù)覽。
Worksheets("Sheet1").PrintPreview

本示例保存當(dāng)前活動工作簿?
ActiveWorkbook.Save

本示例保存所有打開的工作簿，然后關(guān)閉 Microsoft Excel。
For Each w In application.Workbooks
w.Save
Next w
Application.Quit

下例在活動工作簿的第一張工作表前面添加兩張新的工作表?
Worksheets.Add Count:=2, Before:=Sheets(1)

本示例設(shè)置 15 秒后運行 my_Procedure 過程，從現(xiàn)在開始計時。
Application.OnTime Now + TimeValue("00:00:15"), "my_Procedure"

本示例設(shè)置 my_Procedure 在下午 5 點開始運行。
Application.OnTime TimeValue("17:00:00"), "my_Procedure"

本示例撤消前一個示例對 OnTime 的設(shè)置。
Application.OnTime EarliestTime:=TimeValue("17:00:00"), _
Procedure:="my_Procedure", Schedule:=False

每當(dāng)工作表重新計算時，本示例就調(diào)整 A 列到 F 列的寬度。
'Private Sub Worksheet_Calculate()
Columns("A:F").AutoFit
End Sub

本示例使活動工作簿中的計算僅使用顯示的數(shù)字精度。
ActiveWorkbook.PrecisionAsDisplayed = True

本示例將工作表 Sheet1 上的 A1:G37 區(qū)域剪下，并放入剪貼板。
Worksheets("Sheet1").Range("A1:G37").Cut

Calculate 方法
計算所有打開的工作簿、工作簿中的一張?zhí)囟ǖ墓ぷ鞅砘蛘吖ぷ鞅碇兄付▍^(qū)域的單元

格，如下表所示：
'要計算 '依照本示例
所有打開的工作簿 ' Application.Calculate （或只是 Calculate

）
指定工作表 '計算指定工作表Sheet1 Worksheets

("Sheet1").Calculate
指定區(qū)域 'Worksheets(1).Rows(2).Calculate

本示例對自動重新計算功能進行設(shè)置，使 Microsoft Excel 不對第一張工作表自動

進行重新計算。
Worksheets(1).EnableCalculation = False

本示例計算 Sheet1 已用區(qū)域中 A 列、B 列和 C 列的公式。
Worksheets("Sheet1").UsedRange.Columns("A:C").Calculate

本示例更新當(dāng)前活動工作簿中的所有鏈接?
ActiveWorkbook.UpdateLink Name:=ActiveWorkbook.LinkSources

本示例設(shè)置第一張工作表的滾動區(qū)域?
Worksheets(1).ScrollArea = "a1:f10"

本示例新建一個工作簿，提示用戶輸入文件名，然后保存該工作簿。
Set NewBook = Workbooks.Add
Do
fName = Application.GetSaveAsFilename
Loop Until fName False
NewBook.SaveAs Filename:=fName

本示例打開 Analysis.xls 工作簿，然后運行 Auto_Open 宏。
Workbooks.Open "ANALYSIS.XLS"
ActiveWorkbook.RunAutoMacros xlAutoOpen

本示例對活動工作簿運行 Auto_Close 宏，然后關(guān)閉該工作簿。
With ActiveWorkbook
.RunAutoMacros xlAutoClose
.Close
End With

在本示例中，Microsoft Excel 向用戶顯示活動工作簿的路徑和文件名稱。
'Sub UseCanonical()
Display the full path to user.
MsgBox ActiveWorkbook.FullNameURLEncoded
End Sub

本示例顯示當(dāng)前工作簿的路徑及文件名（假定尚未保存此工作簿）。
MsgBox ActiveWorkbook.FullName

本示例關(guān)閉 Book1.xls，并放棄所有對此工作簿的更改。
Workbooks("BOOK1.XLS").Close SaveChanges:=False

本示例關(guān)閉所有打開的工作簿。如果某個打開的工作簿有改變，Microsoft Excel

將顯示詢問是否保存更改的對話框和相應(yīng)提示。
Workbooks.Close

本示例在打印之前對當(dāng)前活動工作簿的所有工作表重新計算?
'Private Sub Workbook_BeforePrint(Cancel As Boolean)
For Each wk In Worksheets
wk.Calculate
Next
End Sub

本示例對查詢表一中的第一列數(shù)據(jù)進行匯總，并在數(shù)據(jù)區(qū)域下方顯示第一列數(shù)據(jù)的總

和。
Set c1 = Sheets("sheet1").QueryTables(1).ResultRange.Columns(1)
c1.Name = "Column1"
c1.End(xlDown).Offset(2, 0).Formula = "=sum(Column1)"

本示例取消活動工作簿中的所有更改?
ActiveWorkbook.RejectAllChanges

本示例在商業(yè)問題中使用規(guī)劃求解函數(shù)，以使總利潤達(dá)到最大值。SolverSave 函數(shù)

將當(dāng)前問題保存到活動工作表上的某一區(qū)域。
Worksheets("Sheet1").Activate
SolverReset
SolverOptions Precision:=0.001
SolverOK SetCell:=Range("TotalProfit"), _
MaxMinVal:=1, _
ByChange:=Range("C4:E6")
SolverAdd CellRef:=Range("F4:F6"), _
Relation:=1, _
FormulaText:=100
SolverAdd CellRef:=Range("C4:E6"), _
Relation:=3, _
FormulaText:=0
SolverAdd CellRef:=Range("C4:E6"), _
Relation:=4
SolverSolve UserFinish:=False
SolverSave SaveArea:=Range("A33")

本示例隱藏 Chart1、Chart3 和 Chart5。
Charts(Array("Chart1", "Chart3", "Chart5")).Visible = False

當(dāng)激活工作表時，本示例對 A1:A10 區(qū)域進行排序。
'Private Sub Worksheet_Activate()
Range("a1:a10").Sort Key1:=Range("a1"), Order:=xlAscending
End Sub

本示例更改 Microsoft Excel 鏈接。
ActiveWorkbook.ChangeLink "c:/excel/book1.xls", _
"c:/excel/book2.xls", xlExcelLinks

本示例啟用受保護的工作表上的自動篩選箭頭?
ActiveSheet.EnableAutoFilter = True
ActiveSheet.Protect contents:=True, userInterfaceOnly:=True

本示例將活動工作簿設(shè)為只讀?
ActiveWorkbook.ChangeFileaccess Mode:=xlReadOnly

本示例使共享工作簿每三分鐘自動更新一次?
ActiveWorkbook.AutoUpdateFrequency = 3

下述 Sub 過程清除活動工作簿中 Sheet1 上的所有單元格的內(nèi)容。
'Sub ClearSheet()
Worksheets("Sheet1").Cells.ClearContents
End Sub

本示例對所有工作簿都關(guān)閉滾動條?
Application.DisplayScrollBars = False

如果具有密碼保護的工作簿的文件屬性沒有加密，則本示例設(shè)置指定工作簿的密碼加

密選項。
'Sub SetPasswordOptions()
With ActiveWorkbook
If .PasswordEncryptionProvider "Microsoft RSA SChannel

Cryptographic Provider" Then
.SetPasswordEncryptionOptions _
PasswordEncryptionProvider:="Microsoft RSA SChannel

Cryptographic Provider", _
PasswordEncryptionAlgorithm:="RC4", _
PasswordEncryptionKeyLength:=56, _
PasswordEncryptionFileProperties:=True
End If
End With
End Sub

在本示例中，如果活動工作簿不能進行寫保護，那么 Microsoft Excel 設(shè)置字符串

密碼以作為活動工作簿的寫密碼。
'Sub UseWritePassword()
Dim strPassword As String
strPassword = "secret"
' Set password to a string if allowed.
If ActiveWorkbook.WriteReserved = False Then
ActiveWorkbook.WritePassword = strPassword
End If
End Sub

在本示例中，Microsoft Excel 打開名為 Password.xls 的工作簿，設(shè)置它的密碼

，然后關(guān)閉該工作簿。本示例假定名為 Password.xls 的文件位于 C:/ 驅(qū)動器上。
'Sub UsePassword()

Dim wkbOne As Workbook

Set wkbOne = Application.Workbooks.Open("C:/Password.xls")

wkbOne.Password = "secret"
wkbOne.Close
'注意 Password 屬性可讀并返回 “********”。
End Sub

本示例將 Book1.xls 的當(dāng)前窗口更改為顯示公式。
Workbooks("BOOK1.XLS").Worksheets("Sheet1").Activate
ActiveWindow.DisplayFormulas = True

'本示例接受活動工作簿中的所有更改?
ActiveWorkbook.AcceptAllChanges

本示例顯示活動工作簿的路徑和名稱
Sub UseCanonical()
MsgBox '消息框
[b7] = ActiveWorkbook.FullName '當(dāng)前工作簿
[b8] = ActiveWorkbook.FullNameURLEncoded '活動工作簿
End Sub

本示例顯示 Microsoft Excel 啟動文件夾的完整路徑。
MsgBox Application.StartupPath

Activate 事件
激活一個工作簿、工作表、圖表或嵌入圖表時產(chǎn)生此事件。
當(dāng)激活工作表時，本示例對 A1:A10 區(qū)域進行排序。
Private Sub Worksheet_Activate()
Range("a1:a10").Sort Key1:=Range("a1"), Order:=xlAscending
End Sub

Calculate 事件
對于 Worksheet 對象，在對工作表進行重新計算之后產(chǎn)生此事件
每當(dāng)工作表重新計算時，本示例就調(diào)整 A 列到 F 列的寬度。
Private Sub Worksheet_Calculate()
Columns("A:F").AutoFit
End Sub

本示例向活動工作簿添加新工作表，并設(shè)置該工作表的名稱。
Set newSheet = Worksheets.Add
newSheet.Name = "current Budget"

本示例關(guān)閉工作簿 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 語句
改變當(dāng)前的目錄或文件夾。
ChDir path
在 Power Macintosh 中，默認(rèn)驅(qū)動器總是改為在 path 語句中指定的驅(qū)動器。完整

路徑指定由卷標(biāo)名開始，相對路徑由冒號 (:) 開始. ChDir 可以辨認(rèn)路徑中指定的

別名:
ChDir "MacDrive:Tmp" ' 在 Macintosh 中

本示例顯示當(dāng)前路徑分隔符。
MsgBox "The path separator character is " & _
Application.PathSeparator

Move 方法
將一個指定的文件或文件夾從一個地方移動到另一個地方。
語法
object.Move destination
Move 方法語法有如下幾部分：
部分 描述
object 必需的。始終是一個 File 或 Folder 對象的名字。
destination 必需的。文件或文件夾要移動到的目標(biāo)。不允許有通配符。

CreateFolder 方法
創(chuàng)建一個文件夾。
語法
object.CreateFolder(foldername)
reateFolder 方法有如下幾部分：
部分 描述
object 必需的。始終是一個 FileSystemObject 的名字。
foldername 必需的。字符串表達(dá)式，它標(biāo)識創(chuàng)建的文件夾。

本示例使用 MkDir 語句來創(chuàng)建目錄或文件夾。如果沒有指定驅(qū)動器，新目錄或文件

夾將會建在當(dāng)前驅(qū)動器中。
MkDir "MYDIR" ' 建立新的目錄或文件夾。

Name 語句示例
本示例使用 Name 語句來更改文件的名稱。示例中假設(shè)所有使用到的目錄或文件夾都

已存在。 在 Macintosh 中，默認(rèn)驅(qū)動器名稱是 “HD” 并且路徑部分由冒號取代

反斜線隔開。
Dim OldName, NewName
OldName = "OLDFILE": NewName = "NEWFILE" ' 定義文件名。
Name OldName As NewName ' 更改文件名。
OldName = "C:/MYDIR/OLDFILE": NewName = "C:/YOURDIR/NEWFILE"
Name OldName As NewName ' 更改文件名，并移動文件。

本示例設(shè)置替換啟動文件夾。
Application.AltStartupPath = "C:/EXCEL/MACROS"

FolderExists 方法
如果指定的文件夾存在返回 True，不存在返回 False。
語法
object.FolderExists(folderspec)

本示例在單元格中啟用編輯。
Application.EditDirectlyInCell = True

程序說明：
幾種用VBA在單元格輸入數(shù)據(jù)的方法：
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是單元格行數(shù)，Column是單元格欄數(shù)。
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 輸入數(shù)據(jù)的方法。
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Target = 100
End Sub

VBALesson4 程序說明：
如何利用 Worksheet_SelectionChange 在限定的單元格輸入數(shù)據(jù)的方法。
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() 來執(zhí)行

程序二者的方法與寫法有何不同。
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

二者執(zhí)行方法最大的地方，在于 Worksheet_SelectionChange() 是自動的，你不用

了解他是怎么完成工作的。
按鈕 CommandButton1_Click() 是人工的，比 SelectionChange()多一道手續(xù)，

就是要去按那接鈕，程序才會執(zhí)行。
SelectionChange() 有一個參數(shù) Target 可用；CommandButton1_Click ()沒有。
所以我們要用 ActiveCell 內(nèi)定函數(shù)來取代Target，ActiveCell 與 Target最大的

不同點他只能指定一個單元格。
就是你選取多個單元格也只有最上面的單元格會加上數(shù)據(jù)；用 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 後的判斷式條件成立的話，就

執(zhí)行第二條程序，否則假如 ElseIf 後的判斷式條件成立的話，就執(zhí)行第四條程序

，否則假如另一個 ElseIf 後的判斷式條件成立的話，就執(zhí)行第六條程序。
Else 的意思是說，假如以上條件都不成立的話，就執(zhí)行第八條程序。
他的執(zhí)行方式是假如 IF 的條件成立的話，就不執(zhí)行其它ElseIf 及Else 的邏輯判

斷式，假如 If 後的條件不成立的話才會執(zhí)行 ElseIf 或 Else 邏輯判斷式。第二

個 ElseIf後的條件因為與 IF 後的條件一樣，所以這個判斷式後面的 Target=400

將是永遠(yuǎn)無法執(zhí)行到的程序。

VBALesson 7 程序說明∶我們?yōu)槭颤N要用變數(shù)。

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 事件來舉例子，大家應(yīng)該能體會他

是怎厶一回事了吧。
這個教程就是要讓你來體會什厶是Worksheet_Chang()事件。因為這二個事件在VBA

都是非常有用的，所以一定要了解。
簡單的說，前者是你鼠標(biāo)移動到那個單元格，就觸發(fā)那個事件的執(zhí)行。後者是要等到

你點選的單元格，數(shù)?有了改變才會觸發(fā)事件的執(zhí)行。二者執(zhí)行的時機一前一後。
Target "" 是代表限定當(dāng)前的單元格要是有數(shù)?的，才會執(zhí)行以下三行的程序。
Cells(iRow, iCol + 1) = Cells(iRow, iCol) * 2，是你在 B 欄輸入數(shù)?時，C

欄將可得到 B 欄二倍的數(shù)?。
Target = "" 是限定當(dāng)前的單元格要是沒有數(shù)?的，才會執(zhí)行以下一行的程序。
Cells(iRow, iCol + 1) = ""，是把 C 欄的數(shù)?清成空格。
Application.EnableEvents = False與Application.EnableEvents = True，這是

個成雙的程序，當(dāng)你用了前者記得在執(zhí)行其他程序後要寫上後面的程序。它的目的在

抑制事件連鎖執(zhí)行。簡單的說就是，在 B 字段所觸發(fā)的事件，不愿在其它單元格再

觸發(fā)另一個Worksheet_Change()事件。

VBALesson 9 程序說明∶體會一下Worksheet_Change()事件連鎖反應(yīng)。

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 輸入新的數(shù)?時，C2 會將 B2 輸入的新數(shù)?加上 C2 原

有的數(shù)?呈現(xiàn)在 C2 上。
照上面有加上 Application.EnableEvents = False 程序執(zhí)行當(dāng)然沒問題。
現(xiàn)在你在 Application.EnableEvents = False 與 Application.EnableEvents =

True 前加上「 '」看看。
程序前加上「 '」的目的是要使「 '」之后的文字變成說明文字，程序執(zhí)行時是會跳

過說明文字，不執(zhí)行說明文字的內(nèi)容。
程序前加上「 '」符號后，文字會變成綠色。
執(zhí)行第二個程序時，你將發(fā)現(xiàn) C2 不會按你所要求的，呈現(xiàn)結(jié)果。
這就是所謂的事件連鎖反應(yīng)。

請問這個宏該如何寫!
我想運行一個宏,就能在當(dāng)前工作表B3上填上一條公式;這條公式的結(jié)果是所有工作
表上的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中怎樣創(chuàng)建一個名為“table”的新工作表
通過VBA編程，很容易添加新的工作表，但是新表的名字不知怎樣控制，對于新創(chuàng)建

的工作表，由于其名字并非特定，所以就不好使用所創(chuàng)建的新表了。不知各位有何高

見。。。。
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
With wSheet
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密碼
'注意事項:執(zhí)行本程式需要在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" '假設(shè)密碼 chijanzen
Application.SendKeys myPW, True '輸入密碼
Application.SendKeys "{TAB}", True 'TAB 鍵(跳到第二次輸入密碼

Textbox
Application.SendKeys myPW, True '輸入密碼
Application.SendKeys "{ENTER}", True '按確定鈕(預(yù)設(shè)值)
Application.SendKeys "%{F11}", True '返回Excel視窗
End Sub

冒泡排序法：
冒泡排序法之所以成為“冒泡排序”是因為值較小的或是較輕的元素浮到作為繼續(xù)排

序的一組數(shù)的頂部。
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“輸入要排序的數(shù)：”
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

首先定義一個數(shù)組：通過循環(huán)錄入10個整數(shù)，然后用一個二重循環(huán)測試前一個數(shù)是否

大于后一個數(shù)。如果大于則交換兩個數(shù)的下標(biāo)，即交換兩個數(shù)在數(shù)組中的位置，交換

通過一個變量來進行。

我先用傳統(tǒng)的方法解決這個問題，經(jīng)過比較，選用了較為簡單的和高效的排序方法
——“快速排序”，具體算法可參考數(shù)據(jù)結(jié)構(gòu)等有關(guān)書籍。對所有數(shù)據(jù)排序后再合
并相同數(shù)據(jù)，合并程序較為簡便，我開始時采用了這種方法，但后來發(fā)現(xiàn)對于這些
的數(shù)據(jù)，先合并后排序速度更快，因為有大量相同的數(shù)據(jù)。合并是采用“標(biāo)記”算
法，具體如下：（設(shè)數(shù)據(jù)已存放在sData()數(shù)組中 ，結(jié)果存到Queryp()數(shù)組，
Amount是數(shù)據(jù)個數(shù)）
'把相同元素置 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)
雖然這樣使得運算速度有所高，但是仍然要進行大量的循環(huán)運算，占據(jù)了程序大部
分的運算時間。于是我一直在尋覓一種更為高效的算法。
功夫不負(fù)有心人，在仔細(xì)分析數(shù)據(jù)的特征，比較了多種方案之后，我終于找到了一
種相當(dāng)成功的算法，原來要3到4秒的運算縮短到僅需0.1到0.2秒。
我遇到的數(shù)據(jù)具有以下特征：①相同數(shù)據(jù)很多，②最大、最小數(shù)之間相差不到3，
③都是帶兩位小數(shù)的正數(shù)。
針對數(shù)據(jù)的特征，我采用了以下算法：
針對數(shù)據(jù)的特征，我采用了以下算法：
步驟：
1． 用一個循環(huán)找出整數(shù)和小數(shù)部分的最大、最小值。小數(shù)部分的最大、最小值乘
以100轉(zhuǎn)為整數(shù)。
2． 定義一個二維數(shù)組，下標(biāo)范圍分別是整數(shù)和小數(shù)部分的最小值到最大值。
3． 再用一個循環(huán)把所有源數(shù)據(jù)填入剛才定義的二維數(shù)組，填寫規(guī)則是，源數(shù)據(jù)的
整數(shù)和小數(shù)部分分別對應(yīng)二維數(shù)組的兩個下標(biāo)。例如，“13.51"填到“A(13,51)"
中。
4． 最后順向或逆向讀取二維數(shù)組中的非零數(shù)據(jù)即可得到從小到大或從大到小排列
的數(shù)據(jù)，而且不會含有重復(fù)數(shù)據(jù)。
用VB 編寫的程序如下：
'＊＊＊＊密集型數(shù)據(jù)處理＊＊＊＊
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()
'讀取數(shù)據(jù)
ReadData
IPmax = 0: IPmin = 1000
DPmax = 0: DPmin = 99

For i = 1 To Amount
' 找整數(shù)和小數(shù)部分的最大、最小值
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)
End If
Next j
Next i
kMax = k
ReDim Preserve Queryp(kMax)
該方法對于本人遇到的這種“密集型”數(shù)據(jù)最為有效，但是如果遇上“稀疏型”數(shù)
據(jù)，例如最大、最小值相差幾千，甚至上萬的數(shù)據(jù)，就沒什么優(yōu)勢了，而且會占用
較大的內(nèi)存。
經(jīng)過改進，我得到了處理稀疏型數(shù)據(jù)的高效算法。高效的前提條件同樣是源數(shù)據(jù)具
有大量相同數(shù)據(jù)。思路是在前一種方法的基礎(chǔ)上增加一個單維數(shù)組，用來保存整數(shù)
部分?jǐn)?shù)據(jù)，保存過程中用插入法對其進行排序。因為有大量重復(fù)數(shù)據(jù)，要排序的數(shù)
據(jù)量相對較少。當(dāng)從二維數(shù)組中讀取數(shù)據(jù)時，用單維數(shù)組代入二維數(shù)組的第一個下
標(biāo)，具體代碼下：
'＊＊＊＊稀疏型數(shù)據(jù)處理＊＊＊＊
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 IPArray() As Integer, IPAamount As Integer
ReDim IPArray(Amount)
Dim DiffDataArray()
'讀取數(shù)據(jù)

ReadData
IPmax = 0: IPmin = 1000
DPmax = 0: DPmin = 99
IPAamount = 0
For i = 1 To Amount
'獲取整數(shù)和小數(shù)部分的最大最小值
IntegerPart = Int(sData(i))
DecimalPart = (sData(i) － IntegerPart) ＊ 100
If IntegerPart > IPmax Then
IPmax = IntegerPart
ElseIf IntegerPart DPmax Then
DPmax = DecimalPart
ElseIf DecimalPart IPArray(j) Then
IPAamount = IPAamount ＋ 1
For k = IPAamount To j ＋ 1 Step －1
IPArray(k) = IPArray(k － 1)
Next k
IPArray(j) = IntegerPart
Exit For
ElseIf IntegerPart = IPArray(j) Then
Exit For
End If
Next j
If j > IPAamount Then
IPAamount = IPAamount ＋ 1
IPArray(IPAamount) = IntegerPart

End If
Next i
ReDim DiffDataArray(IPmin To IPmax, DPmin To DPmax)
'填入數(shù)據(jù)
For i = 1 To Amount
IntegerPart = Int(sData(i))
DecimalPart = (sData(i) － IntegerPart) ＊ 100
DiffDataArray(IntegerPart, DecimalPart) = sData(i)
Next i
'提取數(shù)據(jù)
k = 0
For i = 1 To IPAamount
For j = DPmax To DPmin Step －1
If DiffDataArray(IPArray(i), j) 0 Then
k = k ＋ 1
Queryp(k) = DiffDataArray(IPArray
（i), j)
End If
Next j
Next i
kMax = k
ReDim Preserve Queryp(kMax)
k
ReDim Preserve Queryp(kMax)

自動隱藏表格中無數(shù)據(jù)的行
表1 是數(shù)據(jù)源，經(jīng)常改變；
表2 引用表1 中某列有數(shù)據(jù)的單元格（利用動態(tài)位址已實現(xiàn)。）
由于表1 的改變，表2 的大小隨之而變。
問題：如何實現(xiàn)表2 中沒有數(shù)據(jù)的行（有公式）自動隱藏？謝謝賜教！
Sub abc()
For i = 1 To 300
If Cells(i, 1).value = "" Then Rows(i).Hidden = True
Next i
End Sub
你寫的語句可以解決隱藏的問題，可是如果我執(zhí)行了它之后，再在表1中增加數(shù)據(jù)，

表2不會自動顯示有了數(shù)據(jù)的行。如何修改？
將此宏設(shè)為自動運行（打開文件時）
Sub abc()
For i = 1 To 300
If Cells(i, 1).value "" Then Rows(i).Hidden = false
Next i
End Sub

用VBA如何自動合并列的內(nèi)容？
用VBA如何自動合并列的內(nèi)容？
To hongjian ：
Sub MergeTest()
For i = 3 To 30
Cells(i, 3) = Cells(i, 1) & Chr(10) & Cells(i, 2)
Next
End Sub

1）創(chuàng)建Excel對象
Excel對象模型包括了128個不同的對象，從矩形、文本框等簡單的對
象到透視表，圖表等復(fù)雜的對象。下面簡單介紹一下其中最重要，也是用
得最多的五個對象。

（1）Application對象
Application對象處于Excel對象層次結(jié)構(gòu)的頂層，表示 Excel自身的
運行環(huán)境。

（2）Workbook對象
Workbook對象直接地處于Application對象的下層，表示一個Excel工
作薄文件。

（3）Worksheet對象
Worksheet對象包含于Workbook對象，表示一個Excel工作表。

（4）Range對象
Range對象包含于Worksheet對象，表示 Excel工作表中的一個或多個
單元格。

（5）Cells對象
Cells對象包含于Worksheet對象，表示Excel工作表中的一個單元格。
如果要啟動一個Excel，使用Workbook和Worksheet對象，下面的代碼
啟動了Excel并創(chuàng)建了一個新的包含一個工作表的工作薄：
Dim zsbexcel As Excel.Application
Set zsbexcel = New Excel.Application
zsbexcel.Visible = True
如要Excel不可見，可使zsbexcel.Visible = False
zsbexcel.SheetsInNewWorkbook = 1
Set zsbworkbook = zsbexcel.Workbooks.Add

2）設(shè)置單元格和區(qū)域值
要設(shè)置一張工作表中每個單元格的值，可以使用Worksheet對象的
Range屬性或Cells屬性。
With zsbexcel.ActiveSheet
.Cells(1, 2).value = "100"
.Cells(2, 2).value = "200"
.Cells(3, 2).value = "=SUM(B1:B2)"
.Range("A3:A9") = "中國人民解放軍"
End With
要設(shè)置單元格或區(qū)域的字體、邊框，可以利用Range對象或Cells對象
的Borders屬性和Font屬性：
With objexcel.ActiveSheet.Range("A2:K9").Borders　 '邊框設(shè)置
.Line = xlBorderLine
.Weight = xlThin
.ColorIndex = 1
End With
With objexcel.ActiveSheet.Range("A3:K9").Font　　'字體設(shè)置
.Size = 14
.Bold = True
.Italic = True
.ColorIndex = 3
End With

通過對Excel單元格和區(qū)域值的各種設(shè)置的深入了解,可以創(chuàng)建各種復(fù)
雜、美觀、滿足需要的、具有自己特點的報表。

3）預(yù)覽及打印

生成所需要的工作表后，就可以對EXCEL發(fā)出預(yù)覽、打印指令了。

zsbexcel.ActiveSheet.PageSetup.Orientation = xlPortrait　　 '
設(shè)置打印方向
zsbexcel.ActiveSheet.PageSetup.PaperSize = xlPaperA4　　　'
設(shè)置打印紙的打下
zsbexcel.Caption = "打印預(yù)覽"　　　　　　　 '設(shè)置預(yù)覽窗口的
標(biāo)題
zsbexcel.ActiveSheet.PrintPreview　　　　　　'打印預(yù)覽
zsbexcel.ActiveSheet.PrintOut　　　　　　　　'打印輸出

通過打印方向、打印紙張大小的設(shè)置，不斷進行預(yù)覽，直到滿意為止，
最終進行打印輸出。

為了在退出應(yīng)用程序后EXCEL不提示用戶是否保存已修改的文件,需使
用如下語句：

zsbexcel.DisplayAlerts = False
zsbexcel.Quit　　　 '退出EXCEL
zsbexcel.DisplayAlerts = True

如此設(shè)計的報表打印是通過 EXCEL程序來后臺實現(xiàn)的。對于使用者來
說，根本看不到具體過程，只看到一張張漂亮的報表輕易地被打印出來了。

4）具體實例

下面給出一個具體實例，它在window98、Visual Basic 6.0、
Microsoft Office97的環(huán)境下調(diào)試通過。

在VB中啟動一個新的Standard EXE工程，在“工程”菜單的“引用”
選項下引用Excel Object Library；然后在Form中添加一個命令按鈕
cmdExcel；最后在窗體中輸入如下代碼：

Dim zsbexcel As Excel.Application
Private Sub cmdExcel_Click()
Set zsbexcel = New Excel.Application
zsbexcel.Visible = True
zsbexcel.SheetsInNewWorkbook = 1
Set zsbworkbook = zsbexcel.Workbooks.Add
With zsbexcel.ActiveSheet.Range("A2:C9").Borders　　　'邊框設(shè)置
.Line = xlBorderLine
.Weight = xlThin
.ColorIndex = 1
End With
With zsbexcel.ActiveSheet.Range("A3:C9").Font　　'字體設(shè)置
.Size = 14
.Bold = True
.Italic = True
.ColorIndex = 3
End With
zsbexcel.ActiveSheet.Rows.HorizontalAlignment =
xlVAlignCenter　　　'水平居中

zsbexcel.ActiveSheet.Rows.VerticalAlignment =
xlVAlignCenter　　　　'垂直居中

With zsbexcel.ActiveSheet
.Cells(1, 2).value = "100"
.Cells(2, 2).value = "200"
.Cells(3, 2).value = "=SUM(B1:B2)"
.Cells(1, 3).value = "中國人民解放軍"
.Range("A3:A9") = "50"
End With
zsbexcel.ActiveSheet.PageSetup.Orientation = xlPortrait　　　 '
xlLandscape
zsbexcel.ActiveSheet.PageSetup.PaperSize = xlPaperA4
zsbexcel.ActiveSheet.PrintOut
zsbexcel.DisplayAlerts = False
zsbexcel.Quit
zsbexcel.DisplayAlerts = True
Set zsbexcel = Nothing

提高EXCEL中VBA的效率

方法1：盡量使用VBA原有的屬性、方法和Worksheet函數(shù)
由于Excel對象多達(dá)百多個，對象的屬性、方法、事件多不勝數(shù)，對于初學(xué)者來

說可能對它們不全部了解，這就產(chǎn)生了編程者經(jīng)常編寫與Excel對象的屬性、方法相

同功能的VBA代碼段，而這些代碼段的運行效率顯然與Excel對象的屬性、方法完成

任務(wù)的速度相差甚大。例如用Range的屬性CurrentRegion來返回 Range 對象，該對

象代表當(dāng)前區(qū)。（當(dāng)前區(qū)指以任意空白行及空白列的組合為邊界的區(qū)域）。同樣功能

的VBA代碼需數(shù)十行。因此編程前應(yīng)盡可能多地了解Excel對象的屬性、方法。
充分利用Worksheet函數(shù)是提高程序運行速度的極度有效的方法。如求平均工資

的例子：For Each c In Worksheet(1).Range(″A1:A1000″)
Totalvalue = Totalvalue ＋ c.value
Next
Averagevalue = Totalvalue / Worksheet(1).Range(″

A1:A1000″).Rows.Count
而下面代碼程序比上面例子快得多：
Averagevalue="/blog/Application.WorksheetFunction.Average(Worksheets
(1).Range(″A1:A1000″))
其它函數(shù)如Count,Counta,Countif,Match,Lookup等等，都能代替相同功能的

VBA程序代碼，提高程序的運行速度。

方法2：盡量減少使用對象引用，尤其在循環(huán)中
每一個Excel對象的屬性、方法的調(diào)用都需要通過OLE接口的一個或多個調(diào)用，

這些OLE調(diào)用都是需要時間的，減少使用對象引用能加快VBA代碼的運行。例如
1．使用With語句。
Workbooks(1).Sheets(1).Range(″A1:A1000″).Font.Name=″Pay″
Workbooks(1).Sheets(1).Range(″A1:A1000″).Font.Font

...
則以下語句比上面的快
With Workbooks(1).Sheets(1).Range(″A1:A1000″).Font
.Name = ″Pay″
.Font = ″Bold″
...
End With
2．使用對象變量。
如果你發(fā)現(xiàn)一個對象引用被多次使用，則你可以將此對象用Set 設(shè)置為對象變

量，以減少對對象的訪問。如：
Workbooks(1).Sheets(1).Range(″A1″).value = 100
Workbooks(1).Sheets(1).Range(″A2″).value = 200
則以下代碼比上面的要快：
Set MySheet = Workbooks(1).Sheets(1)
MySheet.Range(″A1″).value = 100
MySheet.Range(″A2″).value = 200
3．在循環(huán)中要盡量減少對象的訪問。
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：減少對象的激活和選擇
如果你的通過錄制宏來學(xué)習(xí)VBA的，則你的VBA程序里一定充滿了對象的激活和選

擇，例如Workbooks(XXX).Activate、Sheets(XXX).Select、Range(XXX).Select等

,但事實上大多數(shù)情況下這些操作不是必需的。例如
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：關(guān)閉屏幕更新
如果你的VBA程序前面三條做得比較差，則關(guān)閉屏幕更新是提高VBA程序運行速度

的最有效的方法，縮短運行時間2/3左右。關(guān)閉屏幕更新的方法：
Application.ScreenUpdate = False
請不要忘記VBA程序運行結(jié)束時再將該值設(shè)回來：
Application.ScreenUpdate = True
以上是提高VBA運行效率的比較有效的幾種方法