跳至內容

Excel VBA

100% developed
來自華夏公益教科書,自由的教學叢書

Microsoft Excel 是一個功能豐富的深層程式。Excel 最強大的功能之一是能夠在 Visual Basic for Applications 中編寫程式,這些程式在工作表“後面”執行,將 Excel 變成一個面向計算的開發平臺,用於建立特殊用途的電子表格,這些電子表格本身可以作為應用程式執行。

Service Pack

[編輯 | 編輯原始碼]

Service Pack(簡稱SP)是軟體程式的更新、修復或增強功能的集合,以單個可安裝包的形式提供。

Service Pack 可以是增量的,這意味著它只包含先前 Service Pack 中不存在的更新,也可以是累積的,這意味著它包含其所有前任的內容。在 Microsoft 產品的情況下,增量更新稱為服務版本。例如,Office 2000 必須升級到服務版本 1(SR-1),然後才能安裝 SP2。

宏安全

[編輯 | 編輯原始碼]

宏安全設定位於信任中心。但是,如果您在組織中工作,系統管理員可能已更改預設設定以阻止任何人更改任何設定並執行宏。

宏錄製

[編輯 | 編輯原始碼]

學習 Excel VBA 的一個好方法是使用它的宏錄製功能。使用此功能,您可以告訴 Excel 開始錄製,然後執行各種步驟,就像您在沒有宏錄製器的情況下工作一樣,最後,告訴 Excel 停止錄製。與您使用 Excel GUI 執行的操作相對應的 VBA 程式碼已由 Excel 錄製。雖然程式碼通常無法在沒有修改的情況下有意義地使用,但從它開始並對其進行修改可以節省大量時間,否則這些時間將花費在閱讀 VBA 文件上。

選單路徑

  • Excel 2000、2003:工具 > 宏 > 錄製新宏。
  • Excel 2007:檢視(選項卡) > 宏(組) > 宏按鈕下方的向下箭頭 > 錄製宏
  • Excel 2007:開發工具(選項卡) > 程式碼(組) > 錄製宏

連結

啟用“開發工具”選項卡

[編輯 | 編輯原始碼]

“開發工具”選項卡允許您插入各種使用者介面控制元件,例如按鈕。要使用它,您首先必須啟用它。

啟用選項卡的選單路徑

  • Excel 2007:圓形 Office 按鈕 > Excel 選項(底部按鈕) > 常規 > 在功能區中顯示“開發工具”選項卡(複選框)
  • Excel 2010:檔案(選項卡) > 選項(按鈕) > 自定義功能區(按鈕) > 開發工具(複選框)

連結

建立 XLA

[編輯 | 編輯原始碼]

XLA 是建立 VBA 程式碼庫的一種方法。它基本上只是一個普通的電子表格(.xls 檔案),但其工作表是隱藏的。以下是建立新工作表的方法

  • 新建工作簿
  • 另存為... 命名為任何名稱
  • 按 Alt-F11
  • 在專案樹中,選擇 VBAProject(whatever.xls)/ThisWorkbook
  • 按 F4 以獲取屬性檢視
  • 找到屬性 IsAddin 並將其設定為 True
  • 按儲存
  • 關閉 Excel
  • 將 whatever.xls 重新命名為 whatever.xla

或者,您可以使用另存為/Excel 載入項。

訪問登錄檔

[編輯 | 編輯原始碼]
  • 適用於:Microsoft Excel 2002 SP-2

此方法用於讀取/寫入應用程式本地金鑰 - 這是為您的 VBA 應用程式提供持久設定。它不涵蓋對登錄檔的任意訪問(即檢視任何金鑰)。

VBA 子程式/函式是 SaveSettingGetSetting。您可以在立即視窗中鍵入以下內容以瞭解它們的工作原理

SaveSetting "MyApplicationName", "MyConfigSection", "MyKeyName", "Hello World"
MsgBox GetSetting("MyApplicationName", "MyConfigSection", "MyKeyName")

如果您想遍歷給定部分中的所有鍵,您可以執行以下操作

Sub ShowAllKeys()
   Dim mySettings As Variant
   mySettings = GetAllSettings("MyApplicationName", "MyConfigSection")
   If Not IsEmpty(MySettings) Then
      Dim counter As Integer
      For counter = LBound(mySettings) To UBound(mySettings)
          Dim keyname As String: keyname = mySettings(counter, 0)
          Dim keyval As String: keyval = mySettings(counter, 1)
          MsgBox keyname & "=" & keyval
      Next
   End If
End Sub

您也可以刪除登錄檔鍵,如下所示

DeleteSetting "MyApplicationName", "MyConfigSection", "MyKeyName"

供參考:Excel/VBA 將其貼上到以下注冊表位置

MyComputer\HKEY_CURRENT_USER\Software\VB and VBA Program Settings\MyApplicationName\MyConfigSection

...其中 MyApplicationMyConfigSection 是您在 SaveSettings 呼叫中指定的任何內容。

它們最終位於 HKEY_CURRENT_USER\Software\VB and VBA Program Settings\MyApplicationName\MyConfigSection。

防止 Excel 中出現確認彈出視窗

[編輯 | 編輯原始碼]
  • 適用於:Microsoft Excel 2002 SP-2

從 VBA 中執行以下呼叫

Application.DisplayAlerts = False

將單元格設為只讀

[編輯 | 編輯原始碼]
  • 適用於:Microsoft Excel 2002 SP-2
Sub ProtectMe()
  Range("A1:IV65536").Locked = False
  Range("A1").Locked = True
  ActiveSheet.Protect Password:="Test"
End Sub

查詢工作表中非空部分

[編輯 | 編輯原始碼]

工作表最大尺寸為 65536 行 x 256 列。但是,如果您想遍歷所有單元格,您可能不想訪問所有空單元格。為此,工作表提供了 UsedRange 屬性。例如

ActiveSheet.UsedRange.Rows.Count

告訴您給定工作表中非空行數。位於第一個和最後一個使用行之間的空行也會被計算在內。例如:如果給定工作表在單元格 A7 和 B16 中有條目,則使用範圍被認為是 A7:B16,共計 10 行。

使用事件

[編輯 | 編輯原始碼]
  • 適用於:Microsoft Excel 2002 SP-2

考慮以下類定義——假設它是一個名為 CMyClass 的類

Option Explicit
Dim WithEvents mySheet As Worksheet

Public Sub Init(aWS as Worksheet)
   Set MySheet = aWS
End Sub

Private Sub mySheet_SelectionChange(ByVal Target As Range)
   Dim MyRange As Range
   For Each MyRange in Target
      Debug.Print CStr(MyRange)
   Next
End Sub

這裡的主要思想是

  • 透過宣告 mySheet WithEvents,您表明 CMyClass 正在監聽 mySheet 的事件。
  • 透過宣告成員子例程 mySheet_SelectionChange,您表明 CMyClass 的例項在 mySheet 遇到選擇更改(即使用者選擇一個新的單元格或單元格範圍)時應該如何反應;事件的一般模式是子成員變數名_事件名(引數)。
  • 您可以透過設定 mySheet = nothing;斷開給定工作表和 CMyClass 之間的事件關聯。
  • 您可以使用以下方法建立丟擲您設計的事件的類
    • 您將在類的頂部宣告:Public Event SomeNiceEventName(YourFavoriteParam1 as WhateverType, etc...),
    • 然後您可以使用 RaiseEvent SomeNiceEvent("Some nice event happened.");觸發該事件(即將其傳送到您的類擁有的任何偵聽器)。
  • Excel 中的 VBA 不喜歡字母 r 或 c 用作變數。這些字母在其他地方代表“行”和“列”。

這裡有更多細節:[1]

注意事項:未捕獲的異常

[編輯 | 編輯原始碼]

注意事項:事件處理程式中的未捕獲異常會導致 VBE 神秘地重置。如果您在事件處理程式中導致了未捕獲的異常,您可能不會收到錯誤彈出視窗。相反,VBE 將重置。因此,您應該確保在所有事件處理程式中捕獲異常。

注意事項:聯機幫助中的錯別字

[編輯 | 編輯原始碼]

某些版本的 Excel 可能會在 F1 幫助中出現錯別字。這是一個具有正確引數的 Click 處理程式示例

 Private Sub clicksrc_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
    MsgBox "I got a click!"
 End Sub

遍歷多選單元格

[編輯 | 編輯原始碼]
  • 適用於:Microsoft Excel 2002 SP-2

以下程式碼片段在使用者選擇的每個單元格中寫入“YAY!”

For Each Cell in Selection
   Cell.Value = "YAY!"
Next

匯出 VBA 程式碼

[編輯 | 編輯原始碼]
  • 適用於 Microsoft Excel 2002 SP-2

以下程式碼提供了一個非常原始的例程來寫入將模組中的 VBA 程式碼序列化到檔案。

Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  Dim objModule As Object
  On Error Resume Next
  
  For Each objModule In ThisWorkbook.VBProject.VBComponents
    DoEvents
    If objModule.CodeModule.CountOfLines > 0 Then
      objModule.Export objModule.Name & ".bas"
    End If
  Next objModule

End Sub

調整命名範圍的大小

[編輯 | 編輯原始碼]
  • Excel 2003

請注意,Range 物件的Resize 屬性不會更改範圍物件的尺寸。它返回一個新的匿名Range 物件。最簡單的方法是設定調整大小範圍的 .Name 屬性

Sub ResizeRange(ByVal RangeName As String, _
                Optional NewRowCount As Long = 0, _
                Optional NewColumnCount As Long = 0)
    
  Dim oRange As Range
  Set oRange = Range(RangeName)
  If NewRowCount = 0 Then
    NewRowCount = oRange.Rows.Count
  End If
  If NewColumnCount = 0 Then
    NewColumnCount = oRange.Columns.Count
  End If
  
  oRange.Resize(NewRowCount, NewColumnCount).Name = RangeName
  
End Sub

建立命名範圍

[編輯 | 編輯原始碼]
  • Excel 2002

命名範圍允許使用者使用名稱而不是單元格地址引用單元格或單元格範圍。此名稱可以在其他單元格公式以及 VBA 中使用(例如,使用[SomeName])。有兩種型別的命名範圍:工作簿名稱工作表名稱

要建立一個工作簿名稱,您可以選擇要命名的單元格,下拉插入-->名稱-->定義...。這將彈出“定義名稱”對話方塊。在這裡,您可以輸入單元格的新名稱。

要建立工作表名稱,您按照相同的步驟進行操作,但在名稱前加上Sheetname!,例如Sheet1!InitialValue,以建立一個僅在工作表Sheet1中可見的命名範圍。

當有兩個具有相同名稱的變數時,一個區域性(工作表名稱)和一個全域性(工作簿名稱),電子表格使用區域性變數。

沒有辦法視覺化命名範圍。最接近的是再次下拉插入-->名稱-->定義...,但此方法不顯示變數是區域性工作表名稱還是全域性工作簿名稱

命名範圍可以是一個單獨的單元格、一行的一部分、一列的一部分或一個矩形單元格組。每個都表現不同

  • 單個單元格可以在工作表中的任何地方被引用,或者,如果它是全域性定義的(工作簿名稱),則可以在任何工作表的任何地方被引用。
  • 組成一行一部分的單元格組只能在平行行中被引用。例如,如果命名變數是mass,並且它跨越單元格 C5:L5,那麼在單元格 E8 處引用mass(例如,像=mass * (3e8)^2這樣的公式)將使用 C8 處的數值,但在單元格 M9 處引用mass將返回錯誤
  • 類似地,組成一列一部分的單元格組只能在平行列中被引用。範圍之外的單元格將返回錯誤
  • 定義邊長大於 1 的矩形陣列的單元格組僅用於在其他工作表中引用 - 因此,在本地(工作表名稱)定義它們沒有意義。例如,如果covmatrix是單元格Sheet1!B2:D4,那麼如果單元格Sheet2!C3具有公式=1/sqrt(covmatrix),那麼它將返回1/sqrt(Sheet1!C3)

讀取檔案

[編輯 | 編輯原始碼]

逐行讀取檔案,也稱為逐行處理檔案

  MyFileName = "C:\Users\Joe\Desktop\File.txt"
  FileNo = FreeFile()
  Open MyFileName For Input As #FileNo
  While Not EOF(FileNo)
    Line Input #FileNo, MyLine
    MsgBox MyLine
  Wend
  Close #FileNo

連結

  • Open 在 Visual Basic for Applications 參考,msdn.microsoft.com
  • Close 在 Visual Basic for Applications 參考,msdn.microsoft.com
  • Line Input 在 Visual Basic for Applications 參考,msdn.microsoft.com

寫入檔案

[編輯 | 編輯原始碼]

寫入檔案

  MyFileName = "C:\Users\Joe\Desktop\File.txt"
  FileNo = FreeFile()
  Open MyFileName For Output As #FileNo
  For I = 1 To 10
    Print #FileNo, Str(I);
    ' The semicolon above prevents printing of a newline
  Next
  Close #FileNo

將當前工作表中以製表符分隔的內容寫入文字檔案,忽略一些單元格內容格式,例如百分比

  MyFileName = "C:\Users\Joe\Desktop\File.txt"
  FileNo = FreeFile()
  Open MyFileName For Output As #FileNo
  RowCount = ActiveSheet.UsedRange.Cells.Rows.Count
  ColumnCount = ActiveSheet.UsedRange.Cells.Columns.Count
  For RowNo = 1 To RowCount
    For ColNo = 1 To ColumnCount
      Print #FileNo, Cells(RowNo, ColNo); ' The semicolon bars newline printing
      If ColNo < ColumnCount Then
        Print #FileNo, vbTab;
      End If
    Next
    If RowNo < RowCount Then
      Print #FileNo, vbNewline;
    End If
  Next
  Close #FileNo

連結

  • Open 在 Visual Basic for Applications 參考,msdn.microsoft.com
  • Close 在 Visual Basic for Applications 參考,msdn.microsoft.com
  • Print # 在 Visual Basic for Applications 參考,msdn.microsoft.com

檔案是否存在

[編輯 | 編輯原始碼]

測試檔案是否存在

  If Dir(MyFileName) <> "" Then
    MsgBox "The file exists."
  End If

建立目錄

  MkDir "C:\Users\Joe\Desktop\TestFolder"

刪除目錄

  RmDir "C:\Users\Joe\Desktop\TestFolder"

更改目錄

  ChDir "C:\Users"

更改當前驅動器

  ChDrive "C:"

列出目錄的內容,使用包含兩個副檔名的自定義過濾器

Directory = "C:\Users\Joe Hoe\"
Set Files = New Collection
Set FileFullPaths = New Collection
MyFile = Dir(Directory)
While MyFile <> ""
  Extension = LCase(Right(MyFile, 4))
  If Extension = ".txt" Or Extension = ".bat" Then
    Files.Add MyFile
    FileFullPaths.Add Directory & MyFile
  End If
  MyFile = Dir() 'Next file or folder
Wend

連結

  • ChDir 在 Visual Basic for Applications 參考,msdn.microsoft.com
  • ChDrive 在 Visual Basic for Applications 參考,msdn.microsoft.com
  • Dir 在 Visual Basic for Applications 參考,msdn.microsoft.com
  • MkDir 在 Visual Basic for Applications 參考,msdn.microsoft.com
  • RmDir 在 Visual Basic for Applications 參考,msdn.microsoft.com

在目錄檔案的行中搜索正則表示式,也稱為 grep

Directory = "C:\Users\Joe Hoe\"
PatternString = "target.*path"
  
MyFile = Dir(Directory)
Set Lines = New Collection
Set RegExp = CreateObject("VBScript.RegExp")
RegExp.Pattern = PatternString
RegExp.IgnoreCase = True
While MyFile <> ""
  Extension = LCase(Right(MyFile, 4))
  If Extension = ".txt" Or Extension = ".bat" Then
    MyFullFileName = Directory & MyFile
    FileNo = FreeFile()
    Open MyFullFileName For Input As #FileNo
    While Not EOF(FileNo)
      Line Input #FileNo, MyLine
      If RegExp.Test(MyLine) Then
        Lines.Add MyLine
      End If
    Wend
    Close #FileNo
  End If
  MyFile = Dir() 'Next file or folder
Wend
'Lines is a collection of the matching lines

剪貼簿

[編輯 | 編輯原始碼]

前提條件:從 Excel 表格訪問剪貼簿需要在表格中設定對 MSForms(Microsoft Forms 物件庫)的引用。可以透過新增和隨後刪除使用者窗體來設定引用,方法是透過插入>使用者窗體在彈出選單中。要檢查引用是否存在,請參閱工具>引用選單。

將文字放置在剪貼簿中

Set MyClipboard = New MSForms.DataObject
MyClipboard.SetText "My string"
MyClipboard.PutInClipboard

從剪貼簿獲取文字

Set MyClipboard = New MSForms.DataObject
MyClipboard.GetFromClipboard
TextContent = MyClipboard.GetText

連結

  • DataObject 類 在 msdn.microsoft.com;包含關於 Visual Basic 的部分,其對 Excel VBA 的適用性尚不清楚

範圍是一組單元格。範圍中的單元格不需要相鄰。但是,單個範圍中的單元格需要屬於單個工作表。

定義新的範圍

Set MyRange = Selection 'The current selection, possibly of multiple cells
Set MyRange = ActiveCell 'The single active cell
Set MyRange = Cells(1, 2) 'Row=1, Column=2 AKA B
Set MyRange = Cells(1, 1).Offset(0, 1) '=Cells(1, 2)
Set MyRange = Cells(1, 2).Offset(0, -1) '=Cells(1, 1)
Set MyRange = Cells(1, 1).Offset(0, -1) 'An error
Set MyRange = Range("A1:C2") 'Letters indicate columns; numbers indicate rows
Set MyRange = Range("A1:A3,C1:C3") 'A discontinuous range
Set MyRange = Range("B2:C2").Cells(1, 1) '=Cells(2, 2) =Range("B2")
Set MyRange = Rows(1) 'An entire row
Set MyRange = Columns(1) 'An entire column
Set MyRange = Cells(2,2).EntireRow
Set MyRange = Cells(2,2).EntireColumn
Set MyRange = Range("B1:C1").EntireColumn 'Two entire columns
Set MyRange = Range("B2:D4").End(xlUp) '=Cells(1, 2) =Range("B1")
Set MyRange = Range("B2:D4").End(xlToLeft) '=Cells(2, 1) = Range("A2")
Set MyRange = Range("B2:D4").End(xlDown) '=Cells(<last row number>, 2)
Set MyRange = Range("B2:D4").End(xlToRight) '=Cells(2, <last column number>)

迭代範圍 AKA 每個範圍中的單元格

Set MyRange = Selection
For Each Cell in MyRange
  MsgBox Cell
Next

迭代行和迭代列 AKA 每個範圍的行和每個範圍的列,即使是不連續的

Set Rng = Range("A1:B1,D3:E3") 'Discontiguous range
For Each Row In Rng.Rows
  RowNo = Row.Row
Next
For Each Column In Rng.Columns
  ColNo = Column.Column
Next

對兩個範圍進行並集(包含兩個範圍的範圍)或交集(僅涵蓋公共單元格的範圍)

Set MyRange = Range("A1:C2")
Set MyRange = Union(MyRange, Range("A5:C5"))
MyRange.Interior.Color = RGB(230, 230, 0)
Set MyRange = Intersect(MyRange, Columns(2))
MyRange.Interior.Color = RGB(230, 100, 0)

選擇範圍

Set MyRange = Sheets(1).Range("A1:B1,D1:E1")
MyRange.Select 'Even a discontinuous range can be selected

啟用單元格

Range("A1:B2").Select 'Affects Selection, generally of multiple cells
Range("A2").Activate 'Affects ActiveCell, the single one

瞭解範圍 AKA 瞭解範圍,包括單元格數量 AKA 單元格計數、第一行、最後一行、第一列、最後一列、行數和列數

Set Rng = Range("B2:D4") 'Contiguous range
NumberOfCells = Rng.Cells.Count
FirstRowNo = Rng.Row
LastRowNo = Rng.Row + Rng.Rows.Count - 1 'Only for contiguous ranges
FirstColNo = Rng.Column
LastColNo = Rng.Column + Rng.Columns.Count - 1 'Only for contiguous ranges

Set Rng = Range("A1:B1,D1:E1") 'Discontiguous range
BrokenLastColNo = Rng.Column + Rng.Columns.Count - 1 'Only for contiguous ranges
'Do it the correct way for discontiguous range
LastColNo = 0
For Each Cell in Rng
  If Cell.Column > LastColNo then
    LastColNo = Cell.Column
  End If
Next

Set RangeWorksheet = Rng.Worksheet

連結

  • 範圍集合 在 Excel 2003 VBA 語言參考中,請參閱 msdn
  • 引用多個範圍 在 Excel 2003 VBA 語言參考中,請參閱 msdn
  • 結束屬性 在 Excel 2003 VBA 語言參考中,請參閱 msdn
  • 交集方法 在 Excel 2003 VBA 語言參考中,請參閱 msdn
  • 並集方法 在 Excel 2003 VBA 語言參考中,請參閱 msdn

工作表

[編輯 | 編輯原始碼]

要建立、訪問或刪除工作表,可以使用工作表物件的 方法。以下是一些示例。

Set MyNewWorksheet = Sheets.Add 'Create
Set MyNewWorksheet2 = Sheets.Add(After:=Sheets(Sheets.Count)) 'Create and place as the last sheet
MyNewWorksheet.Name = "My Sheet"
Set IndexedWorksheet = Sheets(1) 'Access by index
Set NamedWorksheet = Sheets("Name") 'Access by name
Set NamedWorksheet2 = Worksheets("Name") 'Does the same thing as the line above
MyNewWorksheet.Delete
Sheets("Name").Cells(1,1) = "New Value" 'Access the cells of the worksheet
Sheets("Name").Cells.Clear 'Clear an entire worksheet, including formatting and cell values
Sheets("Name").Columns(1).Sort key1:=Sheets("Name").Range("A1") 'Sort the first column
Sheets("Name").Columns(1).Sort key1:=Sheets("Name").Range("A1"), _
  order1:=xlDescending, header:=xlYes 'Use descending instead of ascending; do not sort
                                      ' the first cell, considering it a header
MyNewWorksheet2.Visible = xlSheetHidden
MyNewWorksheet2.Visible = xlSheetVisible

透過名稱獲取現有工作表,或在不存在時建立它

NewSheetName = "My Sheet"
Set MySheet = Nothing
On Error Resume Next
Set MySheet = Sheets(NewSheetName)
On Error GoTo 0
If MySheet Is Nothing Then
  Set MySheet = Sheets.Add(After:=Sheets(Sheets.Count))
  MySheet.Name = NewSheetName
End If

連結

您可以按如下方式在工作表中搜索值

Dim SoughtString As String
SoughtString = "London"
Set ForeignKeySheet = Sheets("CitySize")
Set FoundCell = ForeignKeySheet.Columns(1).Find(SoughtString, LookAt:=xlWhole)
If Not FoundCell Is Nothing Then
  'The value associated with the key is in column 2
  CitySize = FoundCell.Offset(0, 1)
End If

如果您想進行子字串匹配,請刪除“LookAt:=xlWhole”或使用“LookAt:=xlPart”。

連結

單元格格式

[編輯 | 編輯原始碼]

您可以格式化單元格,包括文字顏色、背景顏色、字型屬性和邊框,還可以從 VBA 中將單元格格式化為數字、百分比或文字,如下所示

  Selection.Characters.Font.Color = RGB(0, 0, 255) 'Foreground color AKA text color
  Selection.Interior.Color = RGB(230, 230, 230) 'Background color
  Selection.Characters.Font.ColorIndex = xlAutomatic 'Reset foreground color
  Selection.Interior.Color = xlAutomatic 'Reset background color
  Selection.Font.Name = "Verdana" 'Font face
  Selection.Font.Size = 8 'Font size
  Selection.Font.Bold = True
  Selection.Font.Italic = True
  Selection.Font.Underline = True
  'Selection.Font.Strikethrough = True
  Selection.Font.Name = Application.StandardFont 'See also ClearFormats below
  Selection.Font.Size = Application.StandardFontSize 'See also ClearFormats below
  'Selection.Borders.LineStyle = xlLineStyleNone or xlDouble or xlDashDotDot or other
  Selection.Borders.Weight = xlMedium ' xlHairline, xlThin, xlMedium, or xlThick
  'Selection.Borders(xlEdgeBottom).Weight = xlThick
  ' LineStyle and Weight interact in strange ways.
  Selection.Borders.Color = RGB(127, 127, 0) 'Will be overridden below; applies to all borders
  Selection.Borders(xlEdgeBottom).Color = RGB(255, 0, 0)
  Selection.Borders(xlEdgeTop).Color = RGB(0, 255, 0)
  Selection.Borders(xlEdgeLeft).Color = RGB(0, 0, 255)
  Selection.Borders(xlEdgeRight).Color = RGB(0, 127, 127)
  Selection.Borders(xlInsideHorizontal).Color = &H7FFF00 'A tricky hex matching RGB(0, 255, 127)
  Selection.Borders(xlInsideVertical).Color = RGB(255, 127, 0)

  Selection.NumberFormat = "General"
  Selection.NumberFormat = "00" 'As a number with zero decimal places, showing at least two digits
  Selection.NumberFormat = "0.000" 'As a number, showing three decimal places and no more
  Selection.NumberFormat = "0.0%" 'As a percent with one decimal place
  Selection.NumberFormat = "@" 'As text
  Selection.NumberFormat = "0.00E+00" 'As a number in scientific notation,
                                      'the string before E formatting the significand
  Selection.NumberFormat = "m/d/yyyy" 'As a date; whether "/" is shown depends on locale
  Selection.NumberFormat = "d. mmmm yyyy hh:mm:ss" 'As date, showing the month using a word,
                                      'also showing time
                                        
  Selection.ClearFormats 'Remove formatting, keeping cell content.
                         'Removes also the formatting set using NumberFormat.

連結

在 Excel VBA 中,RGB 顏色是普通數字而不是物件。一些顏色示例在#單元格格式中列出。

一些示例

Selection.Characters.Font.Color = RGB(0, 0, 255) 'Foreground color AKA text color
Selection.Interior.Color = RGB(230, 230, 230) 'Background color
Selection.Characters.Font.ColorIndex = xlAutomatic 'Reset foreground color
Selection.Comment.Shape.Fill.ForeColor.RGB = RGB(220, 255, 160)
'The above is the fill color, that is, the background color
Selection.Comment.Shape.TextFrame.Characters.Font.ColorIndex = 3 'Red per default
'Selection.Comment.Shape.TextFrame.Characters.Font.Color = RGB(255, 0, 0) 'Does not work in Excel 2007
If False Then
  ActiveWorkbook.Colors(3) = RGB(200, 0, 0) 'Make the red in the index 5 a bit darker
End If

將第一列單元格的背景顏色設定為行號顏色索引

For ColorIndex = 1 to 56
  Cells(ColorIndex,1).Interior.ColorIndex = ColorIndex 
Next

預設調色盤中的顏色索引

  • 0 - 自動
  • 1 - 黑色
  • 2 - 白色
  • 3 - 紅色
  • 4 - 綠色
  • 5 - 藍色
  • 6 - 黃色
  • 7 - 洋紅色
  • 8 - 青色
  • 9 - 深紅色
  • 10 - 深綠色
  • 11 - 深藍色
  • ...等等,到 56

查詢所有文字顏色接近綠色的單元格

  TargetColor = RGB(0, 255, 0)
  Tolerance = 200
  'Extract the color components. The extraction is unneeded, but if the target
  'color came from the color of a selected cell, it would be needed.
  TmpColor = TargetColor
  TargetColorRed = TmpColor Mod 256
  TmpColor = TmpColor \ 256
  TargetColorGreen = TmpColor Mod 256
  TmpColor = TmpColor \ 256
  TargetColorBlue = TmpColor Mod 256

  For Each Cell In ActiveSheet.UsedRange.Cells
    MyColor = Cell.Characters.Font.Color 'Color is a number
    'Extract the RGB components of the color
    Red = MyColor Mod 256
    MyColor = MyColor \ 256
    Green = MyColor Mod 256
    MyColor = MyColor \ 256
    Blue = MyColor Mod 256
    'Find the distance from the target color
    Distance = ((Red - TargetColorRed) ^ 2 + _
                (Green - TargetColorGreen) ^ 2 + _
                (Blue - TargetColorBlue) ^ 2) ^ 0.5
    If Distance < Tolerance Then
      Cell.Interior.Color = RGB(230, 230, 230) 'Mark the cell using its background color
    End If
  Next

連結

可見性

[編輯 | 編輯原始碼]

隱藏(隱藏行、隱藏行)

Rows(2).Hidden = True
'Rows(2).Hidden = False 'Show it again

一次隱藏多行

Range("A1:A3").EntireRow.Hidden = True 'Hide rows 1, 2, and 3

隱藏當前選定單元格的行

Selection.EntireRow.Hidden = True

迴圈遍歷可見的行 AKA 顯示 AKA 未隱藏

For RowNo = 1 To 10
  If Not Rows(RowNo).Hidden Then
    'Do something on the row
  End If
Next

切換行的可見性

For RowNo = 1 To 10
  If Not Rows(RowNo).Hidden Then
    Rows(RowNo).Hidden = True
  Else
    Rows(RowNo).Hidden = False
  End If
Next

隱藏(隱藏列、隱藏列)

Columns(2).Hidden = True
'Columns(2).Hidden = False 'Show it again

一次隱藏多列

Range("A1:C1").EntireColumn.Hidden = True 'Hide columns 1, 2, and 3

隱藏當前選定單元格的列

Selection.EntireColumn.Hidden = True

其他與列可見性相關的技巧與上面的行示例完全類似。

[編輯 | 編輯原始碼]

開啟或訪問超連結(開啟超連結、訪問超連結、開啟超連結、訪問超連結)

ActiveWorkbook.FollowHyperlink "http://www.microsoft.com"

透過開啟組合的 URL 來開啟當前活動單元格中找到的條目標題的維基百科條目

ActiveWorkbook.FollowHyperlink "http://en.wikipedia.org/wiki/" & ActiveCell

為當前選定單元格中的任何條目標題開啟維基百科條目

For Each Cell In Selection
  ActiveWorkbook.FollowHyperlink "http://en.wikipedia.org/wiki/" & Cell
Next

開啟本地超連結,可能會彈出一個視窗,要求出於安全原因進行確認

ActiveWorkbook.FollowHyperlink "file://C:\Users\Joe Hoe\Desktop\Test.txt"

連結

臨時檔案

[編輯 | 編輯原始碼]

獲取臨時檔案,以下方法的魯棒性尚不清楚,該方法使用隨機數並測試檔案是否存在

Function GetTempFile(Prefix As String, Suffix As String) As String
  TempFolder = Environ$("tmp")
  Randomize
  While True
    TempFileName = TempFolder & "\" & Prefix & CStr(Int(10000000 * Rnd)) & Suffix
    If Dir(TempFileName) = "" Then 'Then the file does not exist
      GetTempFile = TempFileName
      Exit Function
    End If
  Wend
End Function

連結

命令輸出

[編輯 | 編輯原始碼]

如果您不介意彈出一個控制檯視窗,以下是如何從 Excel VBA 獲取命令輸出的方法

Set MyShell = CreateObject("WScript.Shell")
Set ExecObject = MyShell.Exec("tasklist /v")
' AllText = ExecObject.StdOut.ReadAll
Do While Not ExecObject.StdOut.AtEndOfStream
  Line = ExecObject.StdOut.ReadLine()
  If InStr(Line, "AcroRd32.exe") > 0 Then
    'Do something
  End If
Loop

如果控制檯視窗彈出不可接受,並且您願意建立臨時檔案,以下是如何從 Excel VBA 獲取命令輸出的另一種方法

'Summary: Run "attrib" on the file in column A (1) of the row
'of the currently selected cell, writing the result into
'column B (2) of the row.

'Get temp file name
TempFolder = Environ$("tmp")
Randomize
TempFileName = ""
While TempFileName = ""
  TempFileNameCand = TempFolder & "\" & "mytmp" & CStr(Int(10000000 * Rnd)) & ".tmp"
  If Dir(TempFileNameCand) = "" Then 'Then the file does not exist
    TempFileName = TempFileNameCand
  End If
Wend
 
'Run the command
Set MyShell = CreateObject("WScript.Shell")
MyCommand = "cmd /c attrib """ & Cells(Selection.Row, 1) & """ >" & TempFileName
MyShell.Run MyCommand, 0, True '0 = show no window
'Although attrib has an exe file, we need to use "cmd" for the
'redirection to work.

FileNo = FreeFile()
Open TempFileName For Input As #FileNo
While Not EOF(FileNo)
  Line Input #FileNo, MyLine
  Cells(Selection.Row, 2) = MyLine
Wend
Close #FileNo
Kill TempFileName 'Delete the file to clean up, although not strictly necessary

使用 cmd /c,您還可以執行使用 & 或 | 連線的命令鏈

Set MyShell = CreateObject("WScript.Shell")
Set ExecObject = MyShell.Exec("cmd /c cd /d C:\Users\Joe Hoe & findstr /s knowledge *.txt")
' AllText = ExecObject.StdOut.ReadAll
Do While Not ExecObject.StdOut.AtEndOfStream
  Line = ExecObject.StdOut.ReadLine()
  'Do something
Loop

連結

行高和列寬

Selection.RowHeight = 15
Cells(1,1).RowHeight = 15 'Can be applied to cells, not only to rows
Rows(4).AutoFit 'Automatically adjust row height
'Cells(4, 1).AutoFit 'Error
Cells(4, 1).EntireRow.AutoFit
Selection.EntireRow.AutoFit 'Auto fit the row height of the current selection
ActiveSheet.UsedRange.Rows.AutoFit 'Auto fit the row height of the entire sheet
Selection.RowHeight = ActiveSheet.StandardHeight

Columns(1).ColumnWidth = 70
Cells(1,1).ColumnWidth = 70 'Can be applied to cells, not only to columns
Columns(2).AutoFit 'Automatically adjust column width
Selection.EntireRow.AutoFit 'Auto fit the column width of the current selection
ActiveSheet.UsedRange.Columns.AutoFit 'Auto fit the column width of the entire sheet
Selection.ColumnWidth = ActiveSheet.StandardWidth

連結

使用評論 AKA 備註

If Cells(1,1).Comment Is Nothing Then
  Cells(1,1).AddComment Text:="Hey"
  'AddComment throws an error if the cell already has a comment
  'Range("A2:A3").AddComment Text:="Hey" 'Error
  'AddComment throws an error if applies to more than one cell at once.
End If
Cells(1,1).Comment.Text Text:=Selection.Comment.Text & " there"
Cells(1,1).Comment.Visible = True 'Prevent the comment from autohiding
Cells(1,1).Comment.Visible = False 'The default setting
Cells(1,1).Comment.Shape.Fill.ForeColor.RGB = RGB(220, 255, 160)
'The above is the fill color, that is, the background color
Cells(1,1).Comment.Shape.Height = 60
Cells(1,1).Comment.Shape.Width = 80
Cells(1,1).Comment.Shape.TextFrame.Characters.Font.Name = "Verdana"
Cells(1,1).Comment.Shape.TextFrame.Characters.Font.Size = 9
Cells(1,1).Comment.Shape.TextFrame.Characters(1, 3).Font.Bold = True
If False Then
  'Selection.Comment.Delete
  Cells(1,1).ClearComments
  Range("A1:A2").ClearComments 'Can apply to several cells at once
  Cells(1,1).PasteSpecial Paste:=xlPasteComments
End If

將工作表的所有評論收集到一個字串中

CommentString = ""
For Each Comment in ActiveSheet.Comments
  CommentString = CommentString & " " & Comment.Text
Next

連結

  • 評論物件 在 Excel 2003 VBA 語言參考中,請參閱 msdn
  • 形狀物件 在 Excel 2003 VBA 語言參考中,請參閱 msdn

簡而言之,判斷一個變數是否已被初始化但尚未寫入。

可以用來判斷一個單元格是否為空;單元格中是否存在註釋或單元格的格式並不影響單元格是否為空。

例子

Set MyCell = Cells(1, 1)
If IsEmpty(MyCell) Then
  MyCell.Value = "New value"
End If
'
MyCell.Value = ""
Result1 = IsEmpty(MyCell) 'True
'
Dim MyVar
Result2 = IsEmpty(MyVar) 'True
MyVar = ""
Result3 = IsEmpty(MyVar) 'False
MyVar = Empty
Result4 = IsEmpty(MyVar) 'True

連結

  • IsEmpty at Excel 2010 VBA Language Reference at msdn

判斷一個表示式是否為 Null,它與 Empty 不同。

Null 可以被賦值給 Variant 型別的變數;它不能被賦值給宣告為字串或整數的變數。 Null 不能被賦值給物件,這與 Nothing 不同。

例子

Result1 = IsNull(Null)   'True
Result2 = IsNull(Empty)  'False
'
Dim MyVar As Variant
MyVar = Null             'All right
Result3 = IsNull(MyVar)  'True
Dim MyColl As Collection
Set MyColl = Nothing     'All right
Set MyColl = Null        'Error
Dim MyStr As String
MyStr = Null             'Error
Dim MyInt As Integer
MyInt = Null             'Error

連結

  • IsNull at Excel 2013 VBA Language Reference at msdn

啟動時的載入項

[編輯 | 編輯原始碼]

控制 Excel 啟動時載入的載入項

Microsoft Excel 2003: 透過“工具” -> “載入項” 配置載入的載入項。它們的列表反映在以下注冊表項中,但編輯登錄檔沒有任何優勢。

HKCU\Software\Microsoft\Office\11.0\Excel\Init Commands

Microsoft Excel 2002 SP-2: 當您啟動 Excel 時,它可能會自動載入載入項(即您從“工具” -> “載入項” 中新增的那些載入項)。載入的載入項列表來自以下注冊表項

HKCU\Software\Microsoft\Office\10.0\Excel\Options

在這個鍵下,您可以找到字串變數的列表

  • OPEN
  • OPEN1
  • OPEN2
  • 等等...

這些變數的值是載入項的名稱。Excel 在啟動時會嘗試先載入字串變數 OPEN 中的載入項,然後載入 OPEN1(如果存在),一直到它執行完所有此類字串變數。看起來 Excel 會自動重新編號這些鍵,如果它們不是連續的(例如 OPEN1、OPEN3、OPEN4 將變成 OPEN1、OPEN2、OPEN3)。

還要注意,當您執行“工具” -> “載入項” 時顯示的載入項列表部分是由以下鍵的內容填充的

HKCU\Software\Microsoft\Office\10.0\Excel\Addin Manager

另請參閱以下 MS KB 文章:如何從“載入項” 對話方塊中刪除條目

直接從 VBA 陣列資料建立圖表

[編輯 | 編輯原始碼]

圖表不必基於電子表格單元格中的值,也可以直接在 VBA 中從陣列建立。以下程式碼建立了一個圖表,顯示字串中字元的相對頻率,以百分比表示,或歸一化為最大為 1。還有一個選項可以對顯示進行排序,並且可以透過修改 vRef 陣列的內容或順序來更改內容。還包括刪除圖表和測試函式的程式。

Sub TestChartOfStrFreq()
    'run this to make a chart
    
    Dim str As String, n As Long, c As Long
    
    'place user string here
    str = ""
    
    'if no user string use these random charas
    If str = "" Then
        Do
           DoEvents
           Randomize
           n = Int((127 - 0 + 1) * Rnd + 0)
            Select Case n
            'numbers, and upper and lower letters
            Case 48 To 57, 65 To 90, 97 To 122
               str = str & Chr(n)
               c = c + 1
            End Select
        Loop Until c = 1000
    End If
        
    If ChartOfStrFreq(str, 1, 1) Then MsgBox "Chart done..."

End Sub

Sub DeleteAllWorkbookCharts5()
'run this to delete all charts
    Dim oC
    Application.DisplayAlerts = False
        For Each oC In ThisWorkbook.Charts
           oC.Delete
        Next oC
    Application.DisplayAlerts = True

End Sub

Function ChartOfStrFreq(sIn As String, Optional bSort As Boolean = False, Optional bNormalize As Boolean = False) As Boolean
'makes Excel bar-graph chart for percentage incidence of vRef charas in string (or normalized to max value= 1)
'bSort = True for descending percent otherwise vRef sequence

'PREP
    Dim vRef As Variant, LBC As Long, UBC As Long, LBR As Long, UBR As Long
    Dim vW() As Variant, x() As Variant, y() As Variant
    Dim sUC As String, nC As Long, n As Long, sS As String, nS As Long
    Dim vR As Variant, bCond As Boolean, SortIndex As Long, temp As Variant
    Dim t As Variant, i As Long, j As Long, q As Long, max As Variant
    Dim bXValueLabels As Boolean, sT As String, sX As String, sY As String
    
    If sIn = "" Then
       MsgBox "Empty input string - closing"
       Exit Function
    End If
    
    'load the intended x-axis display set here...add to it and delete as required
    vRef = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", _
                 "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", _
                 "0", "1", "2", "3", "4", "5", "6", "7", "8", "9")
    
    'set axis labels etc...
    sT = "Selective Distribution from a " & Len(sIn) & "-Character String"
    sX = "Character Set of Interest"
    If bNormalize Then
       sY = "Count Divided by Maximum Value"
    Else
       sY = "Percentage of Original String"
    End If
    bXValueLabels = True
    
    
    LBC = LBound(vRef): UBC = UBound(vRef)
    ReDim vW(0 To 2, LBC To UBC)
    LBR = LBound(vW, 1): UBR = UBound(vW, 1)
    ReDim x(LBC To UBC)
    ReDim y(LBC To UBC)

'COUNT
    sUC = UCase(sIn)
    nC = Len(sIn)
    For n = LBC To UBC
       vW(0, n) = vRef(n) 'all charas to first row
       sS = vW(0, n)
       'count hits in string for each chara in ref set
       vW(1, n) = UBound(Split(sUC, sS)) - LBound(Split(sUC, sS)) 'count hits
       'calculate hits as percentages of total chara count
       vW(2, n) = Round(((vW(1, n)) * 100 / nC), 2)
    Next n

'NORMALIZE
    If bNormalize Then
        max = vW(1, FindMax(vW, 1))
        For n = LBC To UBC
           temp = vW(1, n)
           vW(2, n) = Round((temp / max), 2)
        Next n
    End If

'SORT
    If bSort Then
        SortIndex = 2
        'descending sort, on rows
        For i = LBC To UBC - 1
            For j = LBC To UBC - 1
                bCond = vW(SortIndex, j) < vW(SortIndex, j + 1)
                If bCond Then
                    For q = LBR To UBR
                        t = vW(q, j)
                        vW(q, j) = vW(q, j + 1)
                        vW(q, j + 1) = t
                    Next q
                End If
            Next
        Next
    End If

'CHART
    'transfer data to chart arrays
    For n = LBC To UBC
        x(n) = vW(0, n) 'x axis data
        y(n) = vW(2, n) 'y axis data
    Next n

    'make chart
    Charts.Add
    ActiveChart.ChartType = xlColumnClustered 'column chart
       
    'assign the data and labels to a series
    With ActiveChart.SeriesCollection
       If .count = 0 Then .NewSeries
          If bXValueLabels Then
             .Item(1).ApplyDataLabels Type:=xlDataLabelsShowValue
             .Item(1).DataLabels.Orientation = 60
          End If
       If Val(Application.Version) >= 12 Then
          .Item(1).Values = y
          .Item(1).XValues = x
       Else
          .Item(1).Select
          Names.Add "_", x
          ExecuteExcel4Macro "series.x(!_)"
          Names.Add "_", y
          ExecuteExcel4Macro "series.y(,!_)"
          Names("_").Delete
       End If
    End With
    
    'apply title string, x and y axis strings, and delete legend
    With ActiveChart
       .HasTitle = True
       .ChartTitle.Text = sT
       .SetElement (msoElementPrimaryCategoryAxisTitleAdjacentToAxis) 'X
       .Axes(xlCategory).AxisTitle.Text = sX
       .SetElement (msoElementPrimaryValueAxisTitleRotated) 'Y
       .Axes(xlValue).AxisTitle.Text = sY
       .Legend.Delete
    End With
         
    ActiveChart.ChartArea.Select

ChartOfStrFreq = True
    
End Function

Public Function FindMax(arr() As Variant, row As Long) As Long
  Dim myMax As Long
  Dim i As Long
  
  For i = LBound(arr, 2) To UBound(arr, 2)
    If arr(row, i) > myMax Then
      myMax = arr(row, i)
      FindMax = i
    End If
  Next i
End Function

刪除保留狀態

[編輯 | 編輯原始碼]
  • 適用於:Microsoft Excel 2002 SP-2
  • 作業系統:Windows XP

刪除 Excel 的保留狀態:Excel 會記住在執行之間發生的所有事情:載入哪些載入項、顯示哪些按鈕和選單等等。有時您需要清理所有這些東西,並將 Excel 恢復到出廠狀態。

刪除 Excel 檢查清單

  1. 確保以下目錄為空
    1. C:\Program Files\Microsoft Office\Office10\xlstart
    2. C:\apps\xp\application data\Microsoft\xlstart
  2. 從登錄檔中刪除自動開啟鍵(如下所示);
  3. 刪除所有 .xlbs – 例如,在此處檢查
    1. C:\apps\xp\application data\Microsoft\Excel
[編輯 | 編輯原始碼]
[編輯 | 編輯原始碼]
華夏公益教科書