跳轉到內容

Excel VBA

Add links
100% developed
來自華夏公益教科書，開放的書籍，為開放的世界

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

服務包

[編輯 | 編輯原始碼]

服務包（簡稱 SP）是軟體程式的更新、修復或增強功能的集合，以單個可安裝包的形式交付。

服務包可以是增量的，這意味著它只包含以前服務包中不存在的更新；或者它是累積的，這意味著它包含所有先前服務包的內容。在 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 檔案），但其工作表是隱藏的。以下是建立新 XLA 的方法

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

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

訪問登錄檔

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

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

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

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

...其中 MyApplication 和 MyConfigSection 是您在 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]）。命名區域有兩種型別：工作簿名稱和工作表名稱。

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

要建立工作表名稱，您需要按照相同的步驟進行，但將名稱前面加上工作表名稱!，例如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

[編輯 | 編輯原始碼]

在目錄檔案的行中搜索正則表示式，也稱為 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>)

遍歷範圍，也稱為遍歷範圍中的每個單元格

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

遍歷行和遍歷列，也稱為遍歷範圍的每一行和每一列，即使是不連續的

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

瞭解一個區域，即學習一個區域，包括單元格數量、第一行、最後一行、第一列、最後一列、行數和列數

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

連結

工作表

[編輯 | 編輯原始碼]

要建立、訪問或刪除工作表，您可以使用工作表物件的各種方法。以下是示例。

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

迴圈遍歷可見的行（即顯示的行，即未隱藏的行）

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

連結

註釋

[編輯 | 編輯原始碼]

使用註釋（即筆記）

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

連結

IsEmpty

[編輯 | 編輯原始碼]

簡單來說，判斷一個變數是否已初始化但尚未寫入。

可用於判斷單元格是否為空；單元格附加的註釋或單元格格式的存在並不會使單元格變為非空。

示例

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，位於 MSDN 上的 Excel 2010 VBA 語言參考

IsNull

[編輯 | 編輯原始碼]

判斷表示式是否為 Null，這與 Empty 不同。

Null 可以分配給變體變數；它不能分配給宣告為字串或整數的變數。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 在 MSDN 上的 Excel 2013 VBA 語言參考

啟動時載入的載入項

[編輯 | 編輯原始碼]

控制 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

另請參閱以下 Microsoft 知識庫文章：如何從載入項對話方塊中刪除條目。

直接從 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
[編輯 | 編輯原始碼]
[編輯 | 編輯原始碼]
檢索自 "https://wikibook.tw/w/index.php?title=Excel_VBA&oldid=4005080"
華夏公益教科書