跳至内容

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
[编辑 | 编辑源代码]
[编辑 | 编辑源代码]
华夏公益教科书