搜集各種Excel VBA的命令供參考！ 收藏
本示例為設(shè)置密碼窗口 (1)
If Application.InputBox("請(qǐng)輸入密碼：") = 1234 Then
[A1] = 1 '密碼正確時(shí)執(zhí)行
Else: MsgBox "密碼錯(cuò)誤，即將退出！" '此行與第2行共同設(shè)置密碼
End If

本示例為設(shè)置密碼窗口 (1)
X = MsgBox("是否真的要結(jié)帳？", vbYesNo)
If X = vbYes Then
Close

本示例為設(shè)置工作表密碼
ActiveSheet.Protect Password:=641112 ' 保護(hù)工作表并設(shè)置密碼
ActiveSheet.Unprotect Password:=641112 '撤消工作表保護(hù)并取消密碼

'本示例關(guān)閉除正在運(yùn)行本示例的工作簿以外的其他所有工作簿，并保存其更改內(nèi)容

。
For Each w In Workbooks
If w.Name ThisWorkbook.Name Then
w.Close SaveChanges:=True
End If
Next w

'每次打開工作簿時(shí)，本示例都最大化 Microsoft Excel 窗口。
Application.WindowState = xlMaximized

'本示例顯示活動(dòng)工作表的名稱。
MsgBox "The name of the active sheet is " & ActiveSheet.Name

'本示例保存當(dāng)前活動(dòng)工作簿的副本。
ActiveWorkbook.SaveCopyAs "C:\TEMP\XXXX.XLS"

'下述過(guò)程激活工作簿中的第四張工作表。
Sheets(4).Activate

'下述過(guò)程激活工作簿中的第1張工作表。
Worksheets(1).Activate

'本示例通過(guò)將 Saved 屬性設(shè)為 True 來(lái)關(guān)閉包含本段代碼的工作簿，并放棄對(duì)該

工作簿的任何更改。
ThisWorkbook.Saved = True
ThisWorkbook.Close

'本示例對(duì)自動(dòng)重新計(jì)算功能進(jìn)行設(shè)置，使 Microsoft Excel 不對(duì)第一張工作表自

動(dòng)進(jìn)行重新計(jì)算。
Worksheets(1).EnableCalculation = False

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

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

本示例顯示活動(dòng)工作簿中每個(gè)工作表的名稱
For Each ws In Worksheets
MsgBox ws.Name
Next ws

本示例向活動(dòng)工作簿添加新工作表 , 并設(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

本示例新建一張工作表，然后在第一列中列出活動(dòng)工作簿中的所有工作表的名稱。
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)計(jì)算工作簿中的任何工作表時(shí)，本示例對(duì)第一張工作表的 A1:A100 區(qū)域進(jìn)行排序

。
'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)前活動(dòng)工作簿?
ActiveWorkbook.Save

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

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

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

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

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

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

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

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

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

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

）
指定工作表 '計(jì)算指定工作表Sheet1 Worksheets

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

本示例對(duì)查詢表一中的第一列數(shù)據(jù)進(jìn)行匯總，并在數(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)"

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

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

將當(dāng)前問(wèn)題保存到活動(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)激活工作表時(shí)，本示例對(duì) A1:A10 區(qū)域進(jìn)行排序。
'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

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

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

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

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

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

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

密選項(xiàng)。
'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

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

密碼以作為活動(dòng)工作簿的寫密碼。
'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ū)動(dòng)器上。
'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

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

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

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

本示例顯示活動(dòng)工作簿中每個(gè)工作表的名稱。
For Each ws In Worksheets
MsgBox ws.Name
Next ws

本示例關(guān)閉除正在運(yùn)行本示例的工作簿以外的其他所有工作簿，并保存其更改內(nèi)容。
For Each w In Workbooks
If w.Name ThisWorkbook.Name Then
w.Close savechanges:=True
End If
Next w

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

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

BeforeDoubleClick 事件
應(yīng)用于 Worksheet 對(duì)象的 Activate 方法。
當(dāng)雙擊某工作表時(shí)產(chǎn)生此事件，此事件先于默認(rèn)的雙擊操作。
Private Sub expression_BeforeDoubleClick(ByVal Target As Range, Cancel

As Boolean)
expression 引用在類模塊中帶有事件聲明的 Worksheet 類型對(duì)象的變量。
Target 必需。雙擊發(fā)生時(shí)最靠近鼠標(biāo)指針的單元格。
Cancel 可選。當(dāng)事件發(fā)生時(shí)為 False。如果事件過(guò)程將該參數(shù)設(shè)為 True，則該

過(guò)程執(zhí)行完之后將不進(jìn)行默認(rèn)的雙擊操作。

BeforeRightClick 事件
應(yīng)用于 Worksheet 對(duì)象的 Activate 方法。
當(dāng)用鼠標(biāo)右鍵單擊某工作表時(shí)產(chǎn)生此事件，此事件先于默認(rèn)的右鍵單擊操作。
Private Sub expression_BeforeRightClick(ByVal Target As Range, Cancel

As Boolean)
expression 引用在類模塊中帶有事件聲明的 Worksheet 類型對(duì)象的變量。
Target 必需。右鍵單擊發(fā)生時(shí)最靠近鼠標(biāo)指針的單元格。
Cancel 可選。當(dāng)事件發(fā)生時(shí)為 False。如果該事件過(guò)程將本參數(shù)設(shè)為 True，則

該過(guò)程執(zhí)行結(jié)束之后不進(jìn)行默認(rèn)的右鍵單擊操作。

Change 事件
當(dāng)用戶更改工作表中的單元格，或外部鏈接引起單元格的更改時(shí)產(chǎn)生此事件。
Private Sub Worksheet_Change(ByVal Target As Range)
Target 更改的區(qū)域。可以是多個(gè)單元格。
說(shuō)明
重新計(jì)算引起的單元格更改不觸發(fā)本事件?？墒褂?Calculate 事件俘獲工作表重新

計(jì)算操作。
本示例將更改的單元格的顏色設(shè)為藍(lán)色。
Private Sub Worksheet_Change(ByVal Target as Range)
Target.Font.ColorIndex = 5
End Sub

Deactivate 事件
圖表、工作表或工作簿從活動(dòng)狀態(tài)轉(zhuǎn)為非活動(dòng)狀態(tài)時(shí)產(chǎn)生此事件。
Private Sub object_Deactivate()
object Chart、Workbook 或者 Worksheet。有關(guān)對(duì) Chart 對(duì)象使用事件的詳細(xì)

信息，請(qǐng)參閱 Chart 對(duì)象事件的用法。
本示例當(dāng)工作簿轉(zhuǎn)為非活動(dòng)狀態(tài)時(shí)，對(duì)所有打開的窗口進(jìn)行排列。
Private Sub Workbook_Deactivate()
Application.Windows.Arrange xlArrange
End Sub

FollowHyperlink 事件
當(dāng)單擊工作表上的任意超鏈接時(shí)，發(fā)生此事件。對(duì)于應(yīng)用程序級(jí)或工作簿級(jí)的事件，

請(qǐng)參閱 SheetFollowHyperlink 事件。
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Target Hyperlink 類型，必需。一個(gè)代表超鏈接目標(biāo)位置的 Hyperlink 對(duì)象。
本示例對(duì)在當(dāng)前活動(dòng)工作簿中訪問(wèn)過(guò)的所有鏈接保留一個(gè)列表或歷史記錄。
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
With UserForm1
.ListBox1.AddItem Target.Address
.Show
End With
End Sub

PivotTableUpdate 事件
發(fā)生在工作簿中的數(shù)據(jù)透視表更新之后。
Private Sub expression_PivotTableUpdate(ByVal Target As PivotTable)
expression 引用在類模塊中帶有事件聲明的 Worksheet 類型對(duì)象的變量。
Target 必需。選定的數(shù)據(jù)透視表。
本示例顯示一則消息，說(shuō)明數(shù)據(jù)透視表已經(jīng)更新。本示例假定您已在類模塊中聲明了

帶有事件的 Worksheet 類型的對(duì)象。
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
MsgBox "The PivotTable connection has been updated."
End Sub

SelectionChange 事件
當(dāng)工作表上的選定區(qū)域發(fā)生改變時(shí)，將產(chǎn)生本事件。
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Target 新選定的區(qū)域。
本示例滾動(dòng)工作簿窗口，直至選定區(qū)域位于窗口的左上角。
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With ActiveWindow
.ScrollRow = Target.Row
.ScrollColumn = Target.Column
End With
End Sub

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

本示例顯示活動(dòng)工作簿中每個(gè)工作表的名稱。
For Each ws In Worksheets
MsgBox ws.Name
Next ws

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

本示例關(guān)閉工作簿 Book1.xls，但不提示用戶保存所作更改。Book1.xls 中的所有

更改都不會(huì)保存。
Application.DisplayAlerts = False
Workbooks("BOOK1.XLS").Close
Application.DisplayAlerts = True

本示例設(shè)置保存文件時(shí)顯示提示，要求用戶輸入?yún)R總信息。
Application.PromptForSummaryInfo = True

本示例顯示 Microsoft Excel 的完整路徑。
Private Sub aa()
MsgBox "The path is " & Application.Path
End Sub

示例顯示每一個(gè)可用加載宏的路徑及文件名。
For Each a In AddIns
MsgBox a.FullName
Next a

ChDir 語(yǔ)句
改變當(dāng)前的目錄或文件夾。
ChDir path
在 Power Macintosh 中，默認(rèn)驅(qū)動(dòng)器總是改為在 path 語(yǔ)句中指定的驅(qū)動(dòng)器。完整

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

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

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

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

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

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

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

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

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

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

本示例顯示當(dāng)前默認(rèn)文件路徑。
MsgBox "The current default file path is " & _
Application.DefaultFilePath

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

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

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

程序說(shuō)明：
幾種用VBA在單元格輸入數(shù)據(jù)的方法：
Public Sub Writes()
1-- 2 方法，最簡(jiǎn)單在 "[ ]" 中輸入單元格名稱。
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

你點(diǎn)選任何單元格，按 Selection 按鈕，則則所點(diǎn)選的單元格均會(huì)被輸入文字

"Test"。
Public Sub Selection1()
Selection.Value = "Test" '在任何你點(diǎn)選的單元格輸入文字 "Test"。
End Sub

VBALesson2 程序說(shuō)明：
幾種如何把別的工作表 Sheet4 數(shù)據(jù)，讀到這個(gè)工作表的方法：在被讀取的單元格

前加上工作表名稱 Sheet4。
Public Sub Writes()
1-- 2 方法，最簡(jiǎn)單在被讀取的 "[ ]" 前加上被讀取的工作表名稱 Sheet4。
1 [A1] = Sheet4.[A1] '把Sheet4 A1 單元格的數(shù)據(jù)，讀到 A1單元格。
2 [A2:A4] = Sheet4.[B1] ''把 Shee4 工作表單元格 B1 數(shù)據(jù)，讀到 A2:A4

單元格。
3-- 4 方法，在被讀取的工作表 Range(" ")的 Range 前加上被讀取的工作表名稱

Sheet4。
3 Range("B1") = Sheet4.Range("B1") ''把 Shee4工作表單元格 B1 數(shù)據(jù)，讀

到 B1 單元格。
4 Range("C1:C3") = Sheet4.Range("C1") '把 Shee4 工作表單元格 C1 數(shù)據(jù)

，讀到 C1:C3 單元格。
5-- 6 方法，在被讀取的工作表 Cells(Row,Column)，Cells 前加上被讀取工作表

名稱 Sheet4。
5 Cells(1, 4) = Sheet4.Cells(1, 4) '把 Shee4 工作表單元格 D1 數(shù)據(jù)，讀

到 D1 單元格。
6 Range(Cells(1, 5), Cells(5, 5)) = Sheet4.Cells(1, 5) '把 Shee4 工

作表單元格 E1 數(shù)據(jù)，讀到 E1:E 5單元格。
End Sub

你點(diǎn)選任何單元格，按 Selection 按鈕，則所點(diǎn)選的單元格均會(huì)被輸入 Shee4 工

作表單元格 F1 數(shù)據(jù)。
Public Sub Selection1()
Selection.Value = Sheet4.[F1] '把 Shee4 工作表單元格 F1 數(shù)據(jù)，讀到任

何你點(diǎn)選的單元格。
End Sub

VBALesson3 程序說(shuō)明：
如何利用 Worksheet_SelectionChange 輸入數(shù)據(jù)的方法。
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Target = 100
End Sub

Target 指的是你鼠標(biāo)所選的單元格，Worksheet_SelectionChange() 事件的參數(shù)

。
可以是一個(gè)也可以是好幾個(gè)單元格。
Range 是 Excel 特有的變量形態(tài)，叫范圍。
Target As Rang 是把 Target 這個(gè)參數(shù)設(shè)定為 Range 變量形態(tài)。
Target = 100 是把你點(diǎn)選的單元格輸入數(shù)字100。

VBALesson4 程序說(shuō)明：
如何利用 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

If ... Then ... End If 這是我們學(xué)的這一個(gè)邏輯判斷語(yǔ)句。
Target.Row >= 2，指的是鼠標(biāo)選定的單元格的行大于或等于 2。
Target.Column = 2 ，指的是鼠標(biāo)選定的單元格的欄等于 2。
If Target.Row >= 2 And Target.Column = 2 Then 指的是只有在Target.Row >=

2及Target.Column = 2二個(gè)條件成立時(shí)。
就是 (Target.Row >= 2) 為True及(Target.Column = 2)為True時(shí)，才執(zhí)行下面的

程序 Target=100，
也就是 B 欄第二行及以下行用鼠標(biāo)被點(diǎn)選時(shí)，才會(huì)被輸入100，其它單元格則不被輸

入數(shù)據(jù)。

VBALesson5 程序說(shuō)明：
比較 Worksheet_SelectionChange() 與用按鈕 CommandButton1_Click() 來(lái)執(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() 是自動(dòng)的，你不用

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

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

不同點(diǎn)他只能指定一個(gè)單元格。
就是你選取多個(gè)單元格也只有最上面的單元格會(huì)加上數(shù)據(jù)；用 Selection 取代

ActiveCell， 用法就跟 Target 一樣了。

VBALesson 6 程序說(shuō)明：
完整的 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

這是個(gè)完整的 If 邏輯判斷式，意思是說(shuō)，假如 If 後的判斷式條件成立的話，就

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

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

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

個(gè) ElseIf後的條件因?yàn)榕c IF 後的條件一樣，所以這個(gè)判斷式後面的 Target=400

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

VBALesson 7 程序說(shuō)明∶我們?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

跟VBALesson 6比較，程序是不是明朗多了，在前課重復(fù)的用 Target.Row，

Target.Column及Target來(lái)寫程序是不是有一點(diǎn)煩。用變量的第一個(gè)好處大家馬上感

覺(jué)得出來(lái)，就是可以簡(jiǎn)化程序。
使用變量前，你得先宣告變量。宣告變量的方法是在 "Dim " 后面寫上變量 " i

" As 后面接上變量的形態(tài) "Integer"。
Dim i , j As Integer 就是宣告 i 與 j 為整數(shù)變量，這是同時(shí)宣告二個(gè)變量

i 與 j 所以要在二個(gè)變量間加個(gè) " , "號(hào)。
Dim k As Range 是宣告 k 為范圍資料形態(tài)，Range這是 Excel 特有的資料形態(tài)

。
i = Target.Row是把當(dāng)前單元格的行數(shù)，指定給變量 i。
j = Target.Column 是把當(dāng)前單元格的欄數(shù)，指定給變量 j。
Set k = Target 是把當(dāng)前的單元格，指定給變量 k。
用像 i 與 j 這樣簡(jiǎn)單的變量，在程序的前面你可能還記得 i 或 j 代表著

什厶。程序?qū)戦L(zhǎng)了，你可能忘記 i 或 j 代表著什厶。所以最好的方法是用比較有

意義的代號(hào)，來(lái)為變量命名如 iRow 或 iCol 來(lái)取代 i 及 j 。

VBALesson 8 程序說(shuō)明∶體會(huì)一下Worksheet_Change()事件。

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

前幾個(gè)教程都是用Worksheet_SelectionChange 事件來(lái)舉例子，大家應(yīng)該能體會(huì)他

是怎厶一回事了吧。
這個(gè)教程就是要讓你來(lái)體會(huì)什厶是Worksheet_Chang()事件。因?yàn)檫@二個(gè)事件在VBA

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

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

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

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

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

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

VBALesson 9 程序說(shuō)明∶體會(huì)一下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

這個(gè)程序的目的是要在 B2 輸入新的數(shù)時(shí)，C2 會(huì)將 B2 輸入的新數(shù)加上 C2 原

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

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

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

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

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

見(jiàn)。。。。
Sheets.Add
ActiveSheet.Name = "table"

請(qǐng)教：如何用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()
'程式說(shuō)明:利用SendKey輸入VBAProject密碼
'注意事項(xiàng):執(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 保護(hù)頁(yè)面)
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

冒泡排序法：
冒泡排序法之所以成為“冒泡排序”是因?yàn)橹递^小的或是較輕的元素浮到作為繼續(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
‘下面進(jìn)行位置交換
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

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

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

通過(guò)一個(gè)變量來(lái)進(jìn)行。

我先用傳統(tǒng)的方法解決這個(gè)問(wèn)題，經(jīng)過(guò)比較，選用了較為簡(jiǎn)單的和高效的排序方法
——“快速排序”，具體算法可參考數(shù)據(jù)結(jié)構(gòu)等有關(guān)書籍。對(duì)所有數(shù)據(jù)排序后再合
并相同數(shù)據(jù)，合并程序較為簡(jiǎn)便，我開始時(shí)采用了這種方法，但后來(lái)發(fā)現(xiàn)對(duì)于這些
的數(shù)據(jù)，先合并后排序速度更快，因?yàn)橛写罅肯嗤臄?shù)據(jù)。合并是采用“標(biāo)記”算
法，具體如下：（設(shè)數(shù)據(jù)已存放在sData()數(shù)組中 ，結(jié)果存到Queryp()數(shù)組，
Amount是數(shù)據(jù)個(gè)數(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)
雖然這樣使得運(yùn)算速度有所高，但是仍然要進(jìn)行大量的循環(huán)運(yùn)算，占據(jù)了程序大部
分的運(yùn)算時(shí)間。于是我一直在尋覓一種更為高效的算法。
功夫不負(fù)有心人，在仔細(xì)分析數(shù)據(jù)的特征，比較了多種方案之后，我終于找到了一
種相當(dāng)成功的算法，原來(lái)要3到4秒的運(yùn)算縮短到僅需0.1到0.2秒。
我遇到的數(shù)據(jù)具有以下特征：①相同數(shù)據(jù)很多，②最大、最小數(shù)之間相差不到3，
③都是帶兩位小數(shù)的正數(shù)。
針對(duì)數(shù)據(jù)的特征，我采用了以下算法：
針對(duì)數(shù)據(jù)的特征，我采用了以下算法：
步驟：
1． 用一個(gè)循環(huán)找出整數(shù)和小數(shù)部分的最大、最小值。小數(shù)部分的最大、最小值乘
以100轉(zhuǎn)為整數(shù)。
2． 定義一個(gè)二維數(shù)組，下標(biāo)范圍分別是整數(shù)和小數(shù)部分的最小值到最大值。
3． 再用一個(gè)循環(huán)把所有源數(shù)據(jù)填入剛才定義的二維數(shù)組，填寫規(guī)則是，源數(shù)據(jù)的
整數(shù)和小數(shù)部分分別對(duì)應(yīng)二維數(shù)組的兩個(gè)下標(biāo)。例如，“13.51"填到“A(13,51)"
中。
4． 最后順向或逆向讀取二維數(shù)組中的非零數(shù)據(jù)即可得到從小到大或從大到小排列
的數(shù)據(jù)，而且不會(huì)含有重復(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)
該方法對(duì)于本人遇到的這種“密集型”數(shù)據(jù)最為有效，但是如果遇上“稀疏型”數(shù)
據(jù)，例如最大、最小值相差幾千，甚至上萬(wàn)的數(shù)據(jù)，就沒(méi)什么優(yōu)勢(shì)了，而且會(huì)占用
較大的內(nèi)存。
經(jīng)過(guò)改進(jìn)，我得到了處理稀疏型數(shù)據(jù)的高效算法。高效的前提條件同樣是源數(shù)據(jù)具
有大量相同數(shù)據(jù)。思路是在前一種方法的基礎(chǔ)上增加一個(gè)單維數(shù)組，用來(lái)保存整數(shù)
部分?jǐn)?shù)據(jù)，保存過(guò)程中用插入法對(duì)其進(jìn)行排序。因?yàn)橛写罅恐貜?fù)數(shù)據(jù)，要排序的數(shù)
據(jù)量相對(duì)較少。當(dāng)從二維數(shù)組中讀取數(shù)據(jù)時(shí)，用單維數(shù)組代入二維數(shù)組的第一個(gè)下
標(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ù)的性質(zhì)而定，以下是本人的一些實(shí)測(cè)數(shù)據(jù)，僅供參考
。如果你有更好的方法，可不要忘記和朋友們分享哦。

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

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

用VBA如何自動(dòng)合并列的內(nèi)容？
用VBA如何自動(dòng)合并列的內(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

基于VB和EXCEL的報(bào)表設(shè)計(jì)及打印
　　在現(xiàn)代管理信息系統(tǒng)的開發(fā)中，經(jīng)常涉及到數(shù)據(jù)信息的分析、加工，
最終還需把統(tǒng)計(jì)結(jié)果形成各種形式的報(bào)表提供給領(lǐng)導(dǎo)決策參考，或進(jìn)行外
部交流。在Visual Basic中制作報(bào)表，通常是用數(shù)據(jù)環(huán)境設(shè)計(jì)器(Data
Environment Designer)與數(shù)據(jù)報(bào)表設(shè)計(jì)器(Data Report Designer),或者
使用第三方產(chǎn)品來(lái)完成。但對(duì)于大多數(shù)習(xí)慣于Excel報(bào)表的用戶而言,用以
上方法生成的報(bào)表在格式和功能等方面往往不能滿足他們的要求。

　　由于Excel具有自己的對(duì)象庫(kù)，在Visual Basic工程中可以加以引用，
通過(guò)對(duì)Excel使用OLE自動(dòng)化，可以創(chuàng)建一些外觀整潔的報(bào)表，然后打印輸
出。這樣實(shí)現(xiàn)了Visual Basi應(yīng)用程序?qū)xcel的控制。本文將針對(duì)一個(gè)具
體實(shí)例，闡述基于VB和EXCEL的報(bào)表設(shè)計(jì)及打印過(guò)程。

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

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

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

（3）Worksheet對(duì)象
　　Worksheet對(duì)象包含于Workbook對(duì)象，表示一個(gè)Excel工作表。

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

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

　2）設(shè)置單元格和區(qū)域值
　　要設(shè)置一張工作表中每個(gè)單元格的值，可以使用Worksheet對(duì)象的
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") = "中國(guó)人民解放軍"
　　End With
　　要設(shè)置單元格或區(qū)域的字體、邊框，可以利用Range對(duì)象或Cells對(duì)象
的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

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

　3）預(yù)覽及打印

　　生成所需要的工作表后，就可以對(duì)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　　　　　　　　'打印輸出

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

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

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

　　如此設(shè)計(jì)的報(bào)表打印是通過(guò) EXCEL程序來(lái)后臺(tái)實(shí)現(xiàn)的。對(duì)于使用者來(lái)
說(shuō)，根本看不到具體過(guò)程，只看到一張張漂亮的報(bào)表輕易地被打印出來(lái)了。

　4）具體實(shí)例

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

　　在VB中啟動(dòng)一個(gè)新的Standard EXE工程，在“工程”菜單的“引用”
選項(xiàng)下引用Excel Object Library；然后在Form中添加一個(gè)命令按鈕
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 = "中國(guó)人民解放軍"
　　　　.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對(duì)象多達(dá)百多個(gè)，對(duì)象的屬性、方法、事件多不勝數(shù)，對(duì)于初學(xué)者來(lái)

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

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

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

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

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

的例子：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程序代碼，提高程序的運(yùn)行速度。

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

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

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

量，以減少對(duì)對(duì)象的訪問(wèn)。如：
　　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)中要盡量減少對(duì)象的訪問(wè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：減少對(duì)象的激活和選擇
　　如果你的通過(guò)錄制宏來(lái)學(xué)習(xí)VBA的，則你的VBA程序里一定充滿了對(duì)象的激活和選

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

,但事實(shí)上大多數(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程序運(yùn)行速度

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

本示例重復(fù)最近用戶界面命令。本示例必須放在宏的第一行。
Application.Repeat

下例中，變量 counter 代替了行號(hào)。此過(guò)程將在單元格區(qū)域 C1:C20 中循環(huán)，將所

有絕對(duì)值小于 0.01 的數(shù)字都設(shè)置為 0（零）。
Sub RoundToZero1()
For Counter = 1 To 20
Set curCell = Worksheets("Sheet1").Cells(Counter, 3)
If Abs(curCell.Value) 0 Then
' Application.ActivePrinter = "\\zdserver2\HP LaserJet 5000 PCL 6

在 Ne00:" '指定打印機(jī)
ActiveWindow.SelectedSheets.PrintOut Copies:=myPrintNum,

Collate:=True '設(shè)置打印信息,其中Copies:=myPrint為打印份數(shù)
Else
MsgBox "請(qǐng)輸入要打印的份數(shù)"
End If
ActiveSheet.ShowAllData '全部顯示
ActiveSheet.Protect Password:=641112 ' 保護(hù)工作表并設(shè)置密碼
Sheets("封面").Select
Application.ScreenUpdating = True
End Sub

Sub 打印余額()
Application.ScreenUpdating = False
Sheets("余額表").Select
Call 重算所有表
ActiveSheet.Unprotect Password:=641112 '撤消工作表保護(hù)并取消密碼
ActiveWindow.ScrollColumn = 10
Selection.AutoFilter Field:=1, Criteria1:=""
'以下10行彈出窗口輸入打印信息
Dim myPrintNum As Integer
Dim myPrompt, myTitle As String
myPrompt = "請(qǐng)輸入要打印的份數(shù)"
myTitle = "打印選取范圍"
myPrintNum = Application.InputBox(myPrompt, myTitle, 4, , , , , 1)
If myPrintNum 0 Then
' Application.ActivePrinter = "\\zdserver2\HP LaserJet 5000 PCL 6 在

Ne00:" ' '指定打印機(jī)
ActiveWindow.SelectedSheets.PrintOut Copies:=myPrintNum,

Collate:=True '設(shè)置打印信息,其中Copies:=myPrint為打印份數(shù)
Else
MsgBox "請(qǐng)輸入要打印的份數(shù)"
End If
ActiveSheet.ShowAllData '全部顯示
ActiveSheet.Protect Password:=641112 ' 保護(hù)工作表并設(shè)置密碼
Sheets("封面").Select
Application.ScreenUpdating = True
End Sub

Sub 備份()
Dim y '變量聲明-需保存工作表的路徑和名稱
[M1] = ActiveWorkbook.FullName '單元格M1=當(dāng)前工作簿的路徑和名稱
y = cells(1, 14) 'Y=單元格N1的值,即計(jì)算后的需保存工作簿的

路徑和名稱
Worksheets("封面").UsedRange.Columns("M:N").Calculate '計(jì)算指定

區(qū)域
ActiveWorkbook.SaveCopyAs y '備份到指定路么Y
End Sub

Sub 重算活動(dòng)表()
With Application
.Calculation = xlManual
.MaxChange = 0.001
End With
ActiveWorkbook.PrecisionAsDisplayed = True
ActiveWindow.DisplayZeros = True
ActiveSheet.Calculate
End Sub

Sub 重算指定表()
Attribute 重算指定表.VB_ProcData.VB_Invoke_Func = "z\n14"
Worksheets("銀行帳").Calculate
Worksheets("日?qǐng)?bào)表").Calculate
End Sub

單元格數(shù)據(jù)改變引起計(jì)算激活過(guò)程
Private Sub Worksheet_Change(ByVal Target As Range)
Dim irow, icol As Integer
irow = Target.Row '變量行irow
icol = Target.Column '變量列icol
If irow > 6 And icol = 3 And cells(irow, 3) >= cells(irow - 1, 3)

Then '>大于6行,并且第3列,當(dāng)本行 3列>2行3列
Application.EnableEvents = False
cells(irow, 2) = cells(irow - 1, 2) '本行 2 列=上一行2列
Application.EnableEvents = True
ElseIf irow > 6 And icol = 3 And cells(irow, 3) 大于6行,并且第3列,當(dāng)本行 3列>2行3列
Application.EnableEvents = False
cells(irow, 2) = cells(irow - 1, 2) + 1 '本行 2 列=上行2列+1
Application.EnableEvents = True
ElseIf (icol = 3 Or icol = 4 Or icol = 6 Or icol = 8 Or icol = 9 Or

icol = 10 Or icol = 12 Or icol = 13) And irow > 6 Then 'And Target

""
Application.EnableEvents = False
cells(irow, 5) = "=單位名稱"
cells(irow, 7) = "=摘要"
cells(irow, 11) = "=余額"
Range(cells(irow, 14), cells(irow, 16)) = "=預(yù)內(nèi)外收支NOP"
cells(irow, 17) = "=審核Q"
cells(irow, 18) = "=對(duì)帳U"
Range(cells(irow, 19), cells(irow, 20)) = "=內(nèi)轉(zhuǎn)收支XY"
cells(irow, 21) = "=政采Z"
Application.EnableEvents = True
End If
End Sub

'計(jì)算當(dāng)前工作表路徑及名稱的函數(shù),可作為單元格公式,也可寫入宏
=CELL("FILENAME")

'改變Excel界面標(biāo)題的宏
Private Sub Workbook_Open()
Application.Caption = "吃過(guò)了"
End Sub

'自動(dòng)刷新單元格A1內(nèi)顯示的日期\時(shí)間的宏
Sub mytime()
Range("a1") = Now()
Application.OnTime Now + TimeValue("00:00:01"), "mytime"
End Sub

'用單元格A1的內(nèi)容作為文件名保存當(dāng)前工作簿的宏
Sub b()
ActiveWorkbook.SaveCopyAs Range("A1") + ".xls"
End Sub

'激活窗體的宏,此宏寫入有窗體的工作表內(nèi)
Private Sub CommandButton1_Click() '點(diǎn)數(shù)據(jù)錄入按鈕控件激活窗體
Load UserForm3 '激活窗體
UserForm3.StartUpPosition = 3 '激活窗體
UserForm3.Show '激活窗體
End Sub

'以下為窗體中點(diǎn)擊各按鈕運(yùn)行的宏,寫入窗體內(nèi)
Public pos As Integer '聲明變量pos

'戰(zhàn)友確定按鈕語(yǔ)句
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False '此句和最后一句旨在不顯

示宏的執(zhí)行過(guò)程
'On Error GoTo ErrorHandle '可以不要
'ErrorHandle: '可以不要
'If Err.Number = 13 Then '可以不要
'Exit Sub '可以不要
'End If '可以不要
Call writeToWorkSheet '執(zhí)行宏writetoworksheet
UserForm3.Hide '退出窗體,繼續(xù)按鈕少此句,退出按鈕執(zhí)行此句
Unload UserForm3 '退出窗體,繼續(xù)按鈕少此句,退出按鈕執(zhí)行此句
Call 批量打印 '[此處到接順序2]
[L2] = "" '[到此處結(jié)束]
Sheets("打印信息").Select
Application.ScreenUpdating = True
End Sub

'退出按鈕語(yǔ)句
Private Sub CommandButton2_Click()
UserForm3.Hide
Unload UserForm3
End Sub

'將窗體內(nèi)的文本框中的數(shù)據(jù)寫進(jìn)工作表的單元格
Private Sub writeToWorkSheet()
ActiveSheet.Range("k2") = TextBox1.Value '將文字框內(nèi)容寫進(jìn)k列
ActiveSheet.Range("l2") = TextBox2.Value '將文字框內(nèi)容寫進(jìn)l列
TextBox1.Value = "" '清空文字框內(nèi)容
TextBox2.Value = "" '清空文字框內(nèi)容
Worksheets("打印信息").Range("a2").Value = 1 '給指定表的單元格寫入

數(shù)據(jù)
Worksheets("打印信息").Range("B3:E113").Value = "" '清空指定表的單元

格數(shù)據(jù)
End Sub

'以下為根據(jù)條件打印的宏
Sub 打印() '部門明細(xì)查詢及批星打印
Application.ScreenUpdating = False '關(guān)閉屏幕更新
If Cells(1, 4) = "" And Cells(1, 5) = "" Then '打印條件Cells(3,

13) = 1 And
' Application.ActivePrinter = "\\zdserver2\HP LaserJet 5000 PCL

6 在 Ne00:" ' '指定打印機(jī)
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

'設(shè)置默認(rèn)打印機(jī)的打印信息,其中Copies:=myPrint為打印份數(shù)
Else
Call 打印信息 '打倒為假時(shí)執(zhí)行
End If
Application.ScreenUpdating = True '關(guān)閉屏幕更新
End Sub

'以下的循環(huán)過(guò)程,也用于批量打印,Z的值可以是Z=1 TO 5(1到5),也可是單元格的內(nèi)

容
Sub 批量打印()
For Z = Cells(1, 11) To Cells(1, 12) '變量X的值從打印起始號(hào)K1到結(jié)束

號(hào)L1之間逐漸遞增
Cells(1, 13) = Z 'M1的值等于變量X
Next Z
End Sub

'以下是將打印情況寫入工作表的宏
Sub 打印信息()
Application.ScreenUpdating = False '關(guān)閉屏幕更新
Dim Y '聲明變量
Y = ActiveSheet.Name '判定活動(dòng)工作表名稱
Sheets("打印信息").Select
X = 3 '從第3行開始
Do While Not (IsEmpty(Cells(X, 2).Value)) '判斷第1列的最后一行(

即空行的上一行)
X = X + 1 '在最后一行加一行即為空行
Loop
Cells(X, 2) = Cells(2, 1)
Cells(X, 3) = Sheets(Y).Cells(4, 3)
Cells(2, 1) = Cells(2, 1) + 1
Cells(X, 4) = Sheets(Y).Cells(1, 4)
Cells(X, 5) = Sheets(Y).Cells(1, 5)
[c1] = Y
Sheets(Y).Select '返回上一次打開的工作表
Application.ScreenUpdating = True '打開屏幕更新
End Sub

將文件保存為以某一單元格中的值為文件名的宏怎么寫
假設(shè)你要以Sheet1的A1單元格中的值為文件名保存，則應(yīng)用命令：
ActiveWorkbook.SaveCopyAs Str(Range("Sheet1!A1")) + ".xls"

在Excel中,如何用程式控制某一單元格不可編輯修改?thanks!!!
Private Sub Workbook_Open()
ProtectSpecialRange ("A1")
End Sub

Sub ProtectSpecialRange(RangeAddress As String)
On Error Resume Next
With Sheet1
.Cells.Locked = False
.Range(RangeAddress).Locked = True
.Protection.AllowEditRanges.Add Title:="區(qū)域1", Range:=Range

(RangeAddress) _
, Password:="pass"
.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
End Sub

對(duì)工作表編程，有時(shí)要判斷工作表的記錄總數(shù)，VBA里如何實(shí)現(xiàn)？
x=1
do while not (isempty(sheets("").cells(x,1).value)
x=x+1
loop

在VBA中等同于EXCELE中的求和函數(shù)-sum()-的函數(shù)是什么?
Application.WorksheetFunction.Sum()

自定義菜單有三個(gè)菜單項(xiàng)，要求手工順序執(zhí)行。為防止誤操作，執(zhí)行完第一個(gè)菜單項(xiàng)

后使其變灰（禁用），如何寫？
Rowen
令其 Enable　屬性同步與某個(gè)工具按鈕是較為方便的。

如何進(jìn)行表格更新？
是這樣的，比如我已經(jīng)有了一個(gè)原始表格A，這時(shí)有人通知我A表有錯(cuò)誤，須加以修改

，并給我一個(gè)表B，表B列出了須修改的參數(shù)（注意B的列數(shù)少于A的列數(shù)，因A的其他

列無(wú)需修改）?，F(xiàn)在問(wèn)題是如何根據(jù)表B中的新值，在表A中找到相應(yīng)位置，并加以修

改。比如表B中列出了10002的JOHN的身高和體重等值需要修改，如何在A中找到

10002的相應(yīng)位置（身高體重），并加以修改。
建議將表b複製至表a的sheet2，然後執(zhí)行下列的宏即可
sub change()
dim dd as range
sheets(2).select
lastcell = range("a65536").end(xlup).row
for each dd in range(cells(2, 1), cells(lastcell, 1))
if dd = "" then exit sub
ff = dd.value
set c = sheets(1).columns(1).find(ff, lookat:=xlwhole)
if not c is nothing then
c.offset(0, 2) = dd.offset(0, 2)
c.offset(0, 3) = dd.offset(0, 3)
c.offset(0, 5) = dd.offset(0, 4)
end if
next
end sub

自定義菜單
把建立和刪除自定義菜單的代碼分別寫在Workbook_open和Workbook_beforeclosed

的事件中。

應(yīng)該用VBA，工作薄代碼中有workbook-open()過(guò)程，在該過(guò)程中寫入
with activeworkbook
.sheets("表2").active
end with

VBA實(shí)現(xiàn)向鎖定工作表中插入行,并自動(dòng)復(fù)制上面行中指定列的函數(shù)
Option Explicit
Public Const strPass = "123" 123是口令
Sub 行上再插入一行()
ActiveSheet.Unprotect password:=strPass
Selection.Copy
Selection.Insert Shift:=xlDown
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone,

SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Protect password:=strPass
End Sub

如何使不出現(xiàn)每次關(guān)閉XLS文件時(shí)出現(xiàn)的：
“XXX.xls文件已被修改，是否可在其修改后的內(nèi)容？”字樣？？
可以在工作表關(guān)閉之前進(jìn)行手工保存工作
　　ThisWorkbook.save

如何實(shí)現(xiàn)動(dòng)態(tài)時(shí)間顯示?
sub mytime
range("a1")=now()
Application.OnTime Now + Timevalue("00:00:01"), "mytime"
end sub

用 vba 判斷指定 excel 文件是否打開？
For Each w In Workbooks
If w.Name XXX Then
…………
End If
Next w

vba怎么調(diào)用excel自帶的函數(shù)?比如vlookup?
Application.WorksheetFunction.f(x)
f(x)是你想使用的工作表函數(shù)
但是用內(nèi)部函數(shù)時(shí)引用單元格會(huì)出錯(cuò)，怎么辦？
把你要引用的單元格改成VBA認(rèn)可格式（類型）。如在Excel中的“F7:F12”應(yīng)改為

“Range("F7:F12")”等。

VBA中如何關(guān)閉,保存和退出Excel?
Workbooks("你的工作簿").Save。

下表舉例說(shuō)明了使用 Rows 和 Columns 屬性的一些行和列的引用。
引用 含義
Rows(1) 第一行
Rows 工作表上所有的行
Columns(1) 第一列
Columns("A") 第一列
Columns 工作表上所有的列
若要同時(shí)處理若干行或列，請(qǐng)創(chuàng)建一個(gè)對(duì)象變量并使用 Union 方法，將對(duì) Rows 屬

性或 Columns 屬性的多個(gè)調(diào)用組合起來(lái)。下例將活動(dòng)工作簿中第一張工作表上的第

一行、第三行和第五行的字體設(shè)置為加粗。
Sub SeveralRows()
Worksheets("Sheet1").Activate
Dim myUnion As Range
Set myUnion = Union(Rows(1), Rows(3), Rows(5))
myUnion.Font.Bold = True
End Sub

如果只是你說(shuō)的只連接幾個(gè)儲(chǔ)存格那用簡(jiǎn)單的方法
Range("A1").Formula = Application.Evaluate("=[Book2.xls]Sheet1!A1")
或
Range("A1").Formula = "=[Book2.xls]Sheet1!A1"

請(qǐng)問(wèn)在vba如何呼叫已定義的名稱范圍

我在a1:b100插入名稱∶myrange
請(qǐng)問(wèn)我如何用vba選取此范圍
Range("myrange").Select

如何訪問(wèn)沒(méi)有打開的EXCEL文件？
Sub AlternativeImport()
Dim xlapp As Excel.Application
Dim wbSource As Excel.Workbook
Set xlapp = New Excel.Application
xlapp.EnableEvents = False
Set wbSource = xlapp.Workbooks.Open("C:\test\Book2.xls")
Range("A1:A10").Value = wbSource.Sheets("Sheet1").Range

("A1:A10").Value
wbSource.Close False
xlapp.Quit
End Sub

怎樣使VBAprject工程不可查看？（不用密碼）
用可編輯十六進(jìn)制文件的軟件工具（如WinHex等）打開Excel.xls,在文件的尾部,查

找ID="{00000000-0000-0000-0000-000000000000}"(有工程鎖定密碼時(shí)),或

ID="{xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx}"(沒(méi)有工程鎖定密碼時(shí)),修改其中

的任意1位后,保存,即可達(dá)到目的.當(dāng)查看工程是會(huì)出現(xiàn)“工程不可查看”的提示.
注意:修改前,一定要備份原文件,以防不測(cè)

如何用VBA控制報(bào)表的格式（左邊距，紙張大小，打印第幾頁(yè)等）
打印第幾頁(yè)控制:ActiveWindow.SelectedSheets.PrintOut From:=x, To:=y
ActiveSheet.PageSetup.LeftMargin= 左邊距
ActiveSheet.PageSetup..PaperSize = 紙張大小

如何使VBA自動(dòng)消除使用COPY復(fù)制后產(chǎn)生的虛線框？
Application.CutCopyMode = False

替換Excel 97的菜單欄是很容易的，只需創(chuàng)建一個(gè)新的菜單欄就會(huì)刪除Excel 97的

菜單欄。當(dāng)需要恢復(fù)Excel 97的菜單欄時(shí)，只要?jiǎng)h除新創(chuàng)建的菜單欄就可以了。該

系統(tǒng)的自定義菜單中只需兩個(gè)命令按鈕，一個(gè)用來(lái)返回到系統(tǒng)的主畫面

（ReturnMAIN），另一個(gè)用來(lái)退出系統(tǒng)（ExitSYS）。下面是模塊（Module）中有關(guān)

的宏或是事件控制程序。
Sub ZapMenu( )
On Error Resume Next
CommandBars(“保險(xiǎn)查詢系統(tǒng)”).Delete
End Sub
這是一個(gè)用來(lái)刪除自定義菜單欄的宏。語(yǔ)句On Error Resume Next保證無(wú)論自

定義菜單欄是否存在都能正確刪除它。
Sub ExitSYS( )
ZapMenu
ActiveWorkbook.Close SaveChanges := False
End Sub
這是用來(lái)退出系統(tǒng)的宏。它刪除自定義菜單，并關(guān)閉活動(dòng)的工作簿（不提示保存

修改）。
Sub ReturnMAIN( )
Worksheets(“保險(xiǎn)查詢系統(tǒng)”).Select
End Sub
該宏用來(lái)返回主畫面。它激活“保險(xiǎn)查詢系統(tǒng)”工作表。
Sub SetMenu( )
Dim myBar As CommandBar
Dim myButton As CommandBarButton
ZapMenu
Set myBar = CommandBars.Add(Name:=“保險(xiǎn)查詢系統(tǒng)”, _
Position :=msoBarTop, _
MenuBar :=True)
Set myButton = myBar.Controls.Add(msoControlButton)
myButton. = msoButtonCaption
myButton.Caption = “退出[&E]”
myButton.OnAction = “ExitSYS”
Set myButton = myBar.Controls.Add(msoControlButton)
myButton. = msoButtonCaption
myButton.Caption = “返回[&R]”
myButton.OnAction = “ReturnMAIN”
myButton.Visible = False
myBar.Protection = msoBarNoMove + msoBarNoCustomize
myBar.Visible = True
End Sub
這個(gè)宏包含五部分。第一部分定義了一對(duì)變量。第二部分首先運(yùn)行ZapMenu宏，

保證保險(xiǎn)查詢系統(tǒng)菜單欄是不存在的，然后創(chuàng)建它。參數(shù)MenuBar的值設(shè)為True，確

保這個(gè)新創(chuàng)建的命令欄為一菜單欄。第三部分和第四部分將兩個(gè)命令按鈕加入到菜單

欄中。并設(shè)置ReturnMAIN命令按鈕的初始狀態(tài)為不可見(jiàn)狀態(tài)。最后一部分保護(hù)這個(gè)

新創(chuàng)建的菜單欄，使用戶不能移動(dòng)也不能自定義新菜單欄。

工作表匯總
Sub sum() '表匯總,第1張的a1:e20等于所有表的相同單元格的和
Attribute sum.VB_ProcData.VB_Invoke_Func = "z\n14"
Dim X As Worksheet
For y = 1 To 20
For z = 1 To 5
For Each X In Worksheets
shname = X.Name
ActiveSheet.Cells(y, z).Value = ActiveSheet.Cells(y, z).Value +

Worksheets(shname).Cells(y, z)
Next
Next z
Next y
End Sub

發(fā)表于 @ 2008年12月15日　14:22:00 | 評(píng)論( 0 ) | 編輯| 舉報(bào)| 收藏

舊一篇:SQL Server 中的觸發(fā)器使用 | 新一篇:XML 增刪查改
查看最新精華文章 請(qǐng)?jiān)L問(wèn)博客首頁(yè)相關(guān)文章
各種Excel VBA的命令Excel-常用宏技巧（2）Excel-常用宏技巧Excel VBA Range對(duì)象基本操作應(yīng)用示例Excel Application對(duì)象及其常用方法基本操作應(yīng)用示例pio輸出EXCEL示例如何使用 ADO 將數(shù)據(jù)從 ADO 數(shù)據(jù)源傳輸?shù)?ExcelExcel中的VBA編程發(fā)表評(píng)論 表 情：           評(píng)論內(nèi)容：  用 戶 名： 登錄 注冊(cè) 匿名評(píng)論 匿名用戶驗(yàn) 證 碼：   重新獲得驗(yàn)證碼    熱門招聘職位2010支付寶技術(shù)專場(chǎng)招聘【惠普】研發(fā)中心誠(chéng)聘 .NET Tech Lead(Quality Center)【惠普】研發(fā)中心誠(chéng)聘 研發(fā)經(jīng)理(Quality Center) (獵頭職位)【惠普】研發(fā)中心誠(chéng)聘 C++資深開發(fā)工程師北京明天高軟科技 高級(jí)需求分析師北京明天高軟科技有限公司 高級(jí)java工程師北京明天高軟科技 JAVA開發(fā)工程師北京明天高軟科技 測(cè)試工程師【惠普】研發(fā)中心誠(chéng)聘 .NET Senior Developer (Quality Center)【惠普】研發(fā)中心誠(chéng)聘 QA Tech Lead(LoadRunner)【CSDN】招聘:Ruby 工程師、Java搜索工程師、運(yùn)營(yíng)編輯、兼職編輯【惠普】研發(fā)中心誠(chéng)聘 R&D Tech Lead(LoadRunner or QTP) 2010支付寶技術(shù)專場(chǎng)招聘【惠普】研發(fā)中心誠(chéng)聘 .NET Tech Lead(Quality Center)【惠普】研發(fā)中心誠(chéng)聘 研發(fā)經(jīng)理(Quality Center) (獵頭職位)【惠普】研發(fā)中心誠(chéng)聘 C++資深開發(fā)工程師北京明天高軟科技 高級(jí)需求分析師北京明天高軟科技有限公司 高級(jí)java工程師北京明天高軟科技 JAVA開發(fā)工程師北京明天高軟科技 測(cè)試工程師【惠普】研發(fā)中心誠(chéng)聘 .NET Senior Developer (Quality Center)【惠普】研發(fā)中心誠(chéng)聘 QA Tech Lead(LoadRunner)【CSDN】招聘:Ruby 工程師、Java搜索工程師、運(yùn)營(yíng)編輯、兼職編輯【惠普】研發(fā)中心誠(chéng)聘 R&D Tech Lead(LoadRunner or QTP) 

本文來(lái)自CSDN博客，轉(zhuǎn)載請(qǐng)標(biāo)明出處：http://blog.csdn.net/download800720/archive/2008/12/15/3521121.aspx