各種Excel VBA的命令

各種Excel VBA的命令

━━━━━━━━━━━━━━━━━━━━━━━━━━  

本示例爲設置密碼窗口

(1) If Application.InputBox("請輸入密碼：") = 1234 Then

[A1] = 1 '密碼正確時執行 Else: MsgBox "密碼錯誤，即將退出！" '此行與第2行共同設置密碼 End If

本示例爲設置密碼窗口

 (1) X = MsgBox("是否真的要結帳？", vbYesNo) If X = vbYes Then Close

本示例爲設置工作表密碼

ActiveSheet.Protect Password:=641112 ' 保護工作表並設置密碼 ActiveSheet.Unprotect Password:=641112 '撤消工作表保護並取消密碼

'本示例關閉除正在運行本示例的工作簿以外的其他所有工作簿，並保存其更改內容。

 For Each w In Workbooks If w.Name ThisWorkbook.Name Then

 w.Close SaveChanges:=True End If Next w

'每次打開工作簿時，本示例都最大化 Microsoft Excel 窗口。

Application.WindowState = xlMaximized

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

'本示例保存當前活動工作簿的副本。 ActiveWorkbook.SaveCopyAs "C:/TEMP/XXXX.XLS"

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

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

'本示例通過將 Saved 屬性設爲 True 來關閉包含本段代碼的工作簿，並放棄對該

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

'本示例對自動重新計算功能進行設置，使 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

本示例向活動工作簿添加新工作表 , 並設置該工作表的名稱? 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

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

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

本示例保存當前活動工作簿?

ActiveWorkbook.Save

本示例保存所有打開的工作簿，然後關閉 Microsoft Excel。

 For Each w In Application.Workbooks w.Save Next w Application.Quit

下例在活動工作簿的第一張工作表前面添加兩張新的工作表?

Worksheets.Add Count:=2, Before:=Sheets(1)

本示例設置 15 秒後運行 my_Procedure 過程，從現在開始計時。

Application.OnTime Now + TimeValue("00:00:15"), "my_Procedure"

本示例設置 my_Procedure 在下午 5 點開始運行。

Application.OnTime TimeValue("17:00:00"), "my_Procedure"

本示例撤消前一個示例對 OnTime 的設置。

 Application.OnTime EarliestTime:=TimeValue("17:00:00"), _ Procedure:="my_Procedure", Schedule:=False

每當工作表重新計算時，本示例就調整 A 列到 F 列的寬度。

 'Private Sub Worksheet_Calculate() Columns("A:F").AutoFit End Sub

本示例使活動工作簿中的計算僅使用顯示的數字精度。

ActiveWorkbook.PrecisionAsDisplayed = True

本示例將工作表 Sheet1 上的 A1:G37 區域剪下，並放入剪貼板。

Worksheets("Sheet1").Range("A1:G37").Cut

Calculate 方法 計算所有打開的工作簿、工作簿中的一張特定的工作表或者工作表中指定區域的單元格，如下表所示：

'要計算 '依照本示例 所有打開的工作簿

' Application.Calculate （或只是 Calculate ） 指定工作表 '計算指定工作表Sheet1 Worksheets

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

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

Worksheets(1).EnableCalculation = False

本示例計算 Sheet1 已用區域中 A 列、B 列和 C 列的公式。

Worksheets("Sheet1").UsedRange.Columns("A:C").Calculate

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

本示例設置第一張工作表的滾動區域?

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 宏，然後關閉該工作簿。

With ActiveWorkbook .RunAutoMacros xlAutoClose .Close End With

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

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

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

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

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

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

本示例對查詢表一中的第一列數據進行彙總，並在數據區域下方顯示第一列數據的總和。 Set c1 = Sheets("sheet1").QueryTables(1).ResultRange.Columns(1) c1.Name = "Column1" c1.End(xlDown).Offset(2, 0).Formula = "=sum(Column1)"

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

本示例在商業問題中使用規劃求解函數，以使總利潤達到最大值。SolverSave 函數將當前問題保存到活動工作表上的某一區域。

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

當激活工作表時，本示例對 A1:A10 區域進行排序。

'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

本示例將活動工作簿設爲只讀?

ActiveWorkbook.ChangeFileAccess Mode:=xlReadOnly

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

ActiveWorkbook.AutoUpdateFrequency = 3

下述 Sub 過程清除活動工作簿中 Sheet1 上的所有單元格的內容。

 'Sub ClearSheet() Worksheets("Sheet1").Cells.ClearContents

 End Sub

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

如果具有密碼保護的工作簿的文件屬性沒有加密，則本示例設置指定工作簿的密碼加密選項。

 '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 設置字符串密碼以作爲活動工作簿的寫密碼。

 '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 的工作簿，設置它的密碼，然後關閉該工作簿。本示例假定名爲 Password.xls 的文件位於 C:/ 驅動器上。

'Sub UsePassword()

Dim wkbOne As Workbook

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

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

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

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

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

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

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

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

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

Calculate 事件 對於 Worksheet 對象，在對工作表進行重新計算之後產生此事件 每當工作表重新計算時，本示例就調整 A 列到 F 列的寬度。 Private Sub Worksheet_Calculate() Columns("A:F").AutoFit End Sub

BeforeDoubleClick 事件 應用於 Worksheet 對象的 Activate 方法。 當雙擊某工作表時產生此事件，此事件先於默認的雙擊操作。 Private Sub expression_BeforeDoubleClick(ByVal Target As Range, Cancel

As Boolean) expression 引用在類模塊中帶有事件聲明的 Worksheet 類型對象的變量。 Target 必需。雙擊發生時最靠近鼠標指針的單元格。 Cancel 可選。當事件發生時爲 False。如果事件過程將該參數設爲 True，則該過程執行完之後將不進行默認的雙擊操作。

BeforeRightClick 事件 應用於 Worksheet 對象的 Activate 方法。 當用鼠標右鍵單擊某工作表時產生此事件，此事件先於默認的右鍵單擊操作。 Private Sub expression_BeforeRightClick(ByVal Target As Range, Cancel

As Boolean) expression 引用在類模塊中帶有事件聲明的 Worksheet 類型對象的變量。 Target 必需。右鍵單擊發生時最靠近鼠標指針的單元格。 Cancel 可選。當事件發生時爲 False。如果該事件過程將本參數設爲 True，則該過程執行結束之後不進行默認的右鍵單擊操作。

Change 事件 當用戶更改工作表中的單元格，或外部鏈接引起單元格的更改時產生此事件。 Private Sub Worksheet_Change(ByVal Target As Range) Target 更改的區域。可以是多個單元格。 說明 重新計算引起的單元格更改不觸發本事件。可使用 Calculate 事件俘獲工作表重新計算操作。 本示例將更改的單元格的顏色設爲藍色。 Private Sub Worksheet_Change(ByVal Target as Range) Target.Font.ColorIndex = 5 End Sub

Deactivate 事件 圖表、工作表或工作簿從活動狀態轉爲非活動狀態時產生此事件。 Private Sub object_Deactivate() object Chart、Workbook 或者 Worksheet。有關對 Chart 對象使用事件的詳細

信息，請參閱 Chart 對象事件的用法。 本示例當工作簿轉爲非活動狀態時，對所有打開的窗口進行排列。 Private Sub Workbook_Deactivate() Application.Windows.Arrange xlArrange End Sub

FollowHyperlink 事件 當單擊工作表上的任意超鏈接時，發生此事件。對於應用程序級或工作簿級的事件，

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

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

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

SelectionChange 事件 當工作表上的選定區域發生改變時，將產生本事件。 Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) Target 新選定的區域。 本示例滾動工作簿窗口，直至選定區域位於窗口的左上角。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) With ActiveWindow .ScrollRow = Target.Row .ScrollColumn = Target.Column End With End Sub

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

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

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

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

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

本示例設置保存文件時顯示提示，要求用戶輸入彙總信息。 Application.PromptForSummaryInfo = True

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

示例顯示每一個可用加載宏的路徑及文件名。 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 ' 更改文件名，並移動文件。

本示例顯示當前默認文件路徑。 MsgBox "The current default file path is " & _ Application.DefaultFilePath

本示例設置替換啓動文件夾。 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

你點選任何單元格，按 Selection 按鈕，則則所點選的單元格均會被輸入文字

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

VBALesson2 程序說明： 幾種如何把別的工作表 Sheet4 數據，讀到這個工作表的方法：在被讀取的單元格

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

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

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

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

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

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

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

作表單元格 E1 數據，讀到 E1:E 5單元格。 End Sub

你點選任何單元格，按 Selection 按鈕，則所點選的單元格均會被輸入 Shee4 工

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

何你點選的單元格。 End Sub

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

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

。 可以是一個也可以是好幾個單元格。 Range 是 Excel 特有的變量形態，叫範圍。 Target As Rang 是把 Target 這個參數設定爲 Range 變量形態。 Target = 100 是把你點選的單元格輸入數字100。

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

If ... Then ... End If 這是我們學的這一個邏輯判斷語句。 Target.Row >= 2，指的是鼠標選定的單元格的行大於或等於 2。 Target.Column = 2 ，指的是鼠標選定的單元格的欄等於 2。 If Target.Row >= 2 And Target.Column = 2 Then 指的是只有在Target.Row >=

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

程序 Target=100， 也就是 B 欄第二行及以下行用鼠標被點選時，纔會被輸入100，其它單元格則不被輸

入數據。

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

跟VBALesson 6比較，程序是不是明朗多了，在前課重複的用 Target.Row，

Target.Column及Target來寫程序是不是有一點煩。用變量的第一個好處大家馬上感

覺得出來，就是可以簡化程序。 使用變量前，你得先宣告變量。宣告變量的方法是在 "Dim " 後面寫上變量 " i

" As 後面接上變量的形態 "Integer"。 Dim i , j As Integer 就是宣告 i 與 j 爲整數變量，這是同時宣告二個變量

i 與 j 所以要在二個變量間加個 " , "號。 Dim k As Range 是宣告 k 爲範圍資料形態，Range這是 Excel 特有的資料形態

。 i = Target.Row是把當前單元格的行數，指定給變量 i。 j = Target.Column 是把當前單元格的欄數，指定給變量 j。 Set k = Target 是把當前的單元格，指定給變量 k。 用像 i 與 j 這樣簡單的變量，在程序的前面你可能還記得 i 或 j 代表着

什厶。程序寫長了，你可能忘記 i 或 j 代表着什厶。所以最好的方法是用比較有

意義的代號，來爲變量命名如 iRow 或 iCol 來取代 i 及 j 。

VBALesson 8 程序說明∶體會一下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

前幾個教程都是用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 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密碼 '注意事項:執行本程式需要在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) End If Next j Next i kMax = k ReDim Preserve Queryp(kMax) 該方法對於本人遇到的這種“密集型”數據最爲有效，但是如果遇上“稀疏型”數 據，例如最大、最小值相差幾千，甚至上萬的數據，就沒什麼優勢了，而且會佔用 較大的內存。 經過改進，我得到了處理稀疏型數據的高效算法。高效的前提條件同樣是源數據具 有大量相同數據。思路是在前一種方法的基礎上增加一個單維數組，用來保存整數 部分數據，保存過程中用插入法對其進行排序。因爲有大量重複數據，要排序的數 據量相對較少。當從二維數組中讀取數據時，用單維數組代入二維數組的第一個下 標，具體代碼下： '＊＊＊＊稀疏型數據處理＊＊＊＊ 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() '讀取數據

ReadData IPmax = 0: IPmin = 1000 DPmax = 0: DPmin = 99 IPAamount = 0 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 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) '填入數據 For i = 1 To Amount IntegerPart = Int(sData(i)) DecimalPart = (sData(i) － IntegerPart) ＊ 100 DiffDataArray(IntegerPart, DecimalPart) = sData(i) Next i '提取數據 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) 具體採用哪種算法，要看數據的性質而定，以下是本人的一些實測數據，僅供參考 。如果你有更好的方法，可不要忘記和朋友們分享哦。

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

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

用VBA如何自動合併列的內容？ 用VBA如何自動合併列的內容？ 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的報表設計及打印 　　在現代管理信息系統的開發中，經常涉及到數據信息的分析、加工， 最終還需把統計結果形成各種形式的報表提供給領導決策參考，或進行外 部交流。在Visual Basic中製作報表，通常是用數據環境設計器(Data Environment Designer)與數據報表設計器(Data Report Designer),或者 使用第三方產品來完成。但對於大多數習慣於Excel報表的用戶而言,用以 上方法生成的報表在格式和功能等方面往往不能滿足他們的要求。

　　由於Excel具有自己的對象庫，在Visual Basic工程中可以加以引用， 通過對Excel使用OLE自動化，可以創建一些外觀整潔的報表，然後打印輸 出。這樣實現了Visual Basi應用程序對Excel的控制。本文將針對一個具 體實例，闡述基於VB和EXCEL的報表設計及打印過程。

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

（1）Application對象 　　Application對象處於Excel對象層次結構的頂層，表示 Excel自身的 運行環境。

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

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

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

（5）Cells對象 　　Cells對象包含於Worksheet對象，表示Excel工作表中的一個單元格。 　　如果要啓動一個Excel，使用Workbook和Worksheet對象，下面的代碼 啓動了Excel並創建了一個新的包含一個工作表的工作薄： 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）設置單元格和區域值 　　要設置一張工作表中每個單元格的值，可以使用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 　　要設置單元格或區域的字體、邊框，可以利用Range對象或Cells對象 的Borders屬性和Font屬性： 　　With objexcel.ActiveSheet.Range("A2:K9").Borders　 '邊框設置 　　　　.Line = xlBorderLine 　　　　.Weight = xlThin 　　　　.ColorIndex = 1 　　End With 　　With objexcel.ActiveSheet.Range("A3:K9").Font　　'字體設置 　　　　.Size = 14 　　　　.Bold = True 　　　　.Italic = True 　　　　.ColorIndex = 3 　　End With

　　通過對Excel單元格和區域值的各種設置的深入瞭解,可以創建各種復 雜、美觀、滿足需要的、具有自己特點的報表。

　3）預覽及打印

　　生成所需要的工作表後，就可以對EXCEL發出預覽、打印指令了。

　　zsbexcel.ActiveSheet.PageSetup.Orientation = xlPortrait　　 ' 　　設置打印方向 　　zsbexcel.ActiveSheet.PageSetup.PaperSize = xlPaperA4　　　' 　　設置打印紙的打下 　　zsbexcel.Caption = "打印預覽"　　　　　　　 '設置預覽窗口的 　　標題 　　zsbexcel.ActiveSheet.PrintPreview　　　　　　'打印預覽 　　zsbexcel.ActiveSheet.PrintOut　　　　　　　　'打印輸出

　　通過打印方向、打印紙張大小的設置，不斷進行預覽，直到滿意爲止， 最終進行打印輸出。

　　爲了在退出應用程序後EXCEL不提示用戶是否保存已修改的文件,需使 用如下語句：

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

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

　4）具體實例

　　下面給出一個具體實例，它在window98、Visual Basic 6.0、 Microsoft Office97的環境下調試通過。

　　在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　　　'邊框設置 　　　　　　.Line = xlBorderLine 　　　　　　.Weight = xlThin 　　　　　　.ColorIndex = 1 　　　　　　End With 　　　With zsbexcel.ActiveSheet.Range("A3:C9").Font　　'字體設置 　　　　　　 .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函數 　　由於Excel對象多達百多個，對象的屬性、方法、事件多不勝數，對於初學者來

說可能對它們不全部瞭解，這就產生了編程者經常編寫與Excel對象的屬性、方法相

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

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

象代表當前區。（當前區指以任意空白行及空白列的組合爲邊界的區域）。同樣功能

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

的例子：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″)) 　　其它函數如Count,Counta,Countif,Match,Lookup等等，都能代替相同功能的

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

　　方法2：儘量減少使用對象引用，尤其在循環中 　　每一個Excel對象的屬性、方法的調用都需要通過OLE接口的一個或多個調用，

這些OLE調用都是需要時間的，減少使用對象引用能加快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．使用對象變量。 　　 如果你發現一個對象引用被多次使用，則你可以將此對象用Set 設置爲對象變

量，以減少對對象的訪問。如： 　　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．在循環中要儘量減少對象的訪問。 　　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：減少對象的激活和選擇 　　如果你的通過錄制宏來學習VBA的，則你的VBA程序裏一定充滿了對象的激活和選

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

,但事實上大多數情況下這些操作不是必需的。例如 　　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程序運行速度

的最有效的方法，縮短運行時間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("Sheet1").Cells(Counter, 3) If Abs(curCell.Value) 0 Then ' Application.ActivePrinter = "//zdserver2/HP LaserJet 5000 PCL 6

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

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

Sub 打印餘額() Application.ScreenUpdating = False Sheets("餘額表").Select 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) If myPrintNum 0 Then ' Application.ActivePrinter = "//zdserver2/HP LaserJet 5000 PCL 6 在

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

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

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

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

區域 ActiveWorkbook.SaveCopyAs y '備份到指定路麼Y End Sub

Sub 重算活動表() 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("日報表").Calculate End Sub

單元格數據改變引起計算激活過程 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列,當本行 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列,當本行 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)) = "=預內外收支NOP" cells(irow, 17) = "=審覈Q" cells(irow, 18) = "=對帳U" Range(cells(irow, 19), cells(irow, 20)) = "=內轉收支XY" cells(irow, 21) = "=政採Z" Application.EnableEvents = True End If End Sub

'計算當前工作表路徑及名稱的函數,可作爲單元格公式,也可寫入宏 =CELL("FILENAME")

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

'自動刷新單元格A1內顯示的日期/時間的宏 Sub mytime() Range("a1") = Now() Application.OnTime Now + TimeValue("00:00:01"), "mytime" End Sub

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

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

'以下爲窗體中點擊各按鈕運行的宏,寫入窗體內 Public pos As Integer '聲明變量pos

'戰友確定按鈕語句 Private Sub CommandButton1_Click() Application.ScreenUpdating = False '此句和最後一句旨在不顯

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

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

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

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

格數據 End Sub

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

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

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

'設置默認打印機的打印信息,其中Copies:=myPrint爲打印份數 Else Call 打印信息 '打倒爲假時執行 End If Application.ScreenUpdating = True '關閉屏幕更新 End Sub

'以下的循環過程,也用於批量打印,Z的值可以是Z=1 TO 5(1到5),也可是單元格的內

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

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

'以下是將打印情況寫入工作表的宏 Sub 打印信息() Application.ScreenUpdating = False '關閉屏幕更新 Dim Y '聲明變量 Y = ActiveSheet.Name '判定活動工作表名稱 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

將文件保存爲以某一單元格中的值爲文件名的宏怎麼寫 假設你要以Sheet1的A1單元格中的值爲文件名保存，則應用命令： 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:="區域1", Range:=Range

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

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

在VBA中等同於EXCELE中的求和函數-sum()-的函數是什麼? Application.WorksheetFunction.Sum()

自定義菜單有三個菜單項，要求手工順序執行。爲防止誤操作，執行完第一個菜單項

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

如何進行表格更新？ 是這樣的，比如我已經有了一個原始表格A，這時有人通知我A表有錯誤，須加以修改

，並給我一個表B，表B列出了須修改的參數（注意B的列數少於A的列數，因A的其他

列無需修改）。現在問題是如何根據表B中的新值，在表A中找到相應位置，並加以修

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

10002的相應位置（身高體重），並加以修改。 建議將表b複製至表a的sheet2，然後執行下列的宏即可 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

的事件中。

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

VBA實現向鎖定工作表中插入行,並自動複製上面行中指定列的函數 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

如何使不出現每次關閉XLS文件時出現的： “XXX.xls文件已被修改，是否可在其修改後的內容？”字樣？？ 可以在工作表關閉之前進行手工保存工作 　　ThisWorkbook.save

如何實現動態時間顯示? 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怎麼調用excel自帶的函數?比如vlookup? Application.WorksheetFunction.f(x) f(x)是你想使用的工作表函數 但是用內部函數時引用單元格會出錯，怎麼辦？ 把你要引用的單元格改成VBA認可格式（類型）。如在Excel中的“F7:F12”應改爲

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

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

下表舉例說明了使用 Rows 和 Columns 屬性的一些行和列的引用。 引用 含義 Rows(1) 第一行 Rows 工作表上所有的行 Columns(1) 第一列 Columns("A") 第一列 Columns 工作表上所有的列 若要同時處理若干行或列，請創建一個對象變量並使用 Union 方法，將對 Rows 屬

性或 Columns 屬性的多個調用組合起來。下例將活動工作簿中第一張工作表上的第

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

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

請問在vba如何呼叫已定義的名稱範圍

我在a1:b100插入名稱∶myrange 請問我如何用vba選取此範圍 Range("myrange").Select

如何訪問沒有打開的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工程不可查看？（不用密碼） 用可編輯十六進制文件的軟件工具（如WinHex等）打開Excel.xls,在文件的尾部,查

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

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

的任意1位後,保存,即可達到目的.當查看工程是會出現“工程不可查看”的提示. 注意:修改前,一定要備份原文件,以防不測

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

如何使VBA自動消除使用COPY複製後產生的虛線框？ Application.CutCopyMode = False

 

替換Excel 97的菜單欄是很容易的，只需創建一個新的菜單欄就會刪除Excel 97的

菜單欄。當需要恢復Excel 97的菜單欄時，只要刪除新創建的菜單欄就可以了。該

系統的自定義菜單中只需兩個命令按鈕，一個用來返回到系統的主畫面

（ReturnMAIN），另一個用來退出系統（ExitSYS）。下面是模塊（Module）中有關

的宏或是事件控制程序。 Sub ZapMenu( ) On Error Resume Next CommandBars(“保險查詢系統”).Delete End Sub 這是一個用來刪除自定義菜單欄的宏。語句On Error Resume Next保證無論自

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

修改）。 Sub ReturnMAIN( ) Worksheets(“保險查詢系統”).Select End Sub 該宏用來返回主畫面。它激活“保險查詢系統”工作表。 Sub SetMenu( ) Dim myBar As CommandBar Dim myButton As CommandBarButton ZapMenu Set myBar = CommandBars.Add(Name:=“保險查詢系統”, _ 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 這個宏包含五部分。第一部分定義了一對變量。第二部分首先運行ZapMenu宏，

保證保險查詢系統菜單欄是不存在的，然後創建它。參數MenuBar的值設爲True，確

保這個新創建的命令欄爲一菜單欄。第三部分和第四部分將兩個命令按鈕加入到菜單

欄中。並設置ReturnMAIN命令按鈕的初始狀態爲不可見狀態。最後一部分保護這個

新創建的菜單欄，使用戶不能移動也不能自定義新菜單欄。

工作表彙總 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