Visual Basic for Applications（VBA）是一种Visual Basic的一种宏语言，主要能用来扩展Windows的应用程式功能，特别是Microsoft Office。也可说是一种应用程式视觉化的Basic Script。下面总结了一些VBA的常用代码。

1. 单元格操作

1.1 Range 

赋值：Set data = Sheets("Sheet1").range("A1:B6")

清除：Range("A1:C3").ClearContents

偏移：Set newrange = Range("A1").Offset(0, 1)

2. 文件读写

2.1 Excel文件

Application.ScreenUpdating = FalseDim app as New Excel.Applicationapp.Visible = False Dim book As Excel.WorkbookSet book = app.Workbooks.Add(fileName)'' 在这里添加任务代码'book.Close SaveChanges:=Falseapp.QuitSet app = NothingApplication.ScreenUpdating = True

 

2.2 文本文件

OpenTextFile(filename[, iomode[, create[, format]]])：打开指定的文件并返回一个 TextStream 对象，可以通过这个对象对文件进行读、写或追加。

 

参数

object：必选项。 object 应为 FileSystemObject 的名称。

filename：必选项。 指明要打开文件的字符串表达式。

iomode：可选项。 可以是三个常数之一： ForReading 、 ForWriting 或 ForAppending 。

create：可选项。 Boolean 值，指明当指定的 filename 不存在时是否创建新文件。 如果创建新文件则值为 True ，如果不创建则为 False 。 如果忽略，则不创建新文件。

format：可选项。 使用三态值中的一个来指明打开文件的格式。 如果忽略，那么文件将以 ASCII 格式打开。

 

iomode：可选项。参数可以是下列设置中的任一种：

常数 值 描述

ForReading 1 以只读方式打开文件。 不能写这个文件。

ForWriting 2 以写方式打开文件

ForAppending 8 打开文件并从文件末尾开始写。

 

format：可选项。 参数可以是下列设置中的任一种：

值 描述

TristateTrue 以 Unicode 格式打开文件。

TristateFalse 以 ASCII 格式打开文件。

TristateUseDefault 使用系统默认值打开文件。

 

例子：

Set fs = CreateObject("Scripting.FileSystemObject")Set file = fs.OpenTextFile("C:\example.txt", 2, True)file.writeliine "It's a test."file.Close

 3. 获取路径

ActiveWorkbook.Path 得到所在的目录，没有最后一个“\”

ActiveWorkbook.FullName 得到完整的路径，包括文件名

CurDir(drive) 当前工作路径，例如

CurDir () 返回 "C:\Documents and Settings\user\My Documents"

CurDir ("G") 返回 "G:\

 

4. 对话框

4.1 文件夹对话框

树形目录：

Set objSheel = CreateObject("Shell.Application")Set objFolder = obSheel.BrowseForFolder(0, "Select Directory", 0,0)path = objFolder.self.path

 

上面方法有个问题，无法自定义默认的文件目录。借用文件选择对话框，可解决该问题，代码如下：

Function GetFolder(strPath As String) As StringDim fldr As FileDialogDim sItem As StringSet fldr = Application.FileDialog(msoFileDialogFolderPicker)With fldr    .Title = "Select a Folder"    .AllowMultiSelect = False    .InitialFileName = strPath    If .Show <> -1 Then GoTo NextCode    sItem = .SelectedItems(1)End WithNextCode:GetFolder = sItemSet fldr = NothingEnd Function

 

4.2 文件对话框

Dim fd As FileDialogDim objfl As VariantDim filnam As StringSet fd = Application.FileDialog(msoFileDialogFilePicker)With fd    .ButtonName = "Select"    .AllowMultiSelect = False    .Filters.Add "Text Files", "*.txt;*.csv;*.tab;*.asc", 1    .title = "Choose Transactions file to import"    .InitialView = msoFileDialogViewDetails    .Show    For Each objfl In .SelectedItems        filnam = objfl    Next objfl    On Error GoTo 0End WithSet fd = Nothing

 

4. 图表操作

4.1 获取和修改图表名

按住shift键，鼠标选中图表，再松开shift键。名称框里会显示图表名，也可以在此修改图表名。

4.2 图表操作

下面是个具体例子，包含图表位置，尺寸，数据源等内容的设置

Sub Chart_Update()          Dim varColor As Variant     Dim Num_Rnd As Integer          varColor = Array("41", "50", "3", "4", "7")     '操作图表前，先关闭界面更新，结束后再开启。这样可以加快执行速度    Application.ScreenUpdating = False               Num_Rnd = Calc_Round_Num()               With Sheets("Gameboard").ChartObjects("Data")                   ' 位置和尺寸        .Left = 26         .Width = 898         .Top = 282         .Height = 367                           With .Chart             .HasTitle = True             .ChartTitle.Text = "Normalized Data"                          .Axes(xlCategory, xlPrimary).HasTitle = True             .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Round Number"             .Axes(xlValue, xlPrimary).HasTitle = True             .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Ratio"             .Axes(xlCategory).MinimumScale = 0             .Axes(xlCategory).MaximumScale = 10             .Axes(xlCategory).Crosses = xlCustom             .Axes(xlCategory).CrossesAt = -100                          With .Legend                 .Top = 57                 .Height = 248                 .Left = 728                 .Width = 155             End With                          With .PlotArea                 .Top = 47                 .Height = 284                 .Left = 30                 .Width = 687             End With                                        '图表数据            For i = 1 To .SeriesCollection.Count                 With .SeriesCollection(i)                     .Name = "=Gameboard!r" & 22 + i & "c4"                     .XValues = "=Gameboard!R17C9:R17C" & 8 + Num_Rnd                     .Values = "=Gameboard!R" & 22 + i & "C9:R" & 22 + i & "C" & 8 + Num_Rnd                                           ' 图表边界                    With .Border                         .ColorIndex = varColor(i - 1)                         .Weight = xlMedium                         .LineStyle = xlContinuous                     End With                                           ' 图表Marker                    .MarkerForegroundColorIndex = varColor(i - 1)                     .MarkerBackgroundColorIndex = varColor(i - 1)                     .MarkerStyle = xlSquare                     .MarkerSize = 5                 End With             Next         End With     End With          Application.ScreenUpdating = True      End Sub

 

 5. Sheet操作

5.1 遍历EXCEL中的Sheet，获取Sheet名

Dim sht As WorksheetFor Each sht In Sheets   MsgBox sht.nameNext sht

 

6. 内容查询 

6.1 Range.Find 和 Range.FindNext的使用

With Worksheets(1).Range("a1:a500")     Set c = .Find(2, lookin:=xlValues)     If Not c Is Nothing Then         firstAddress = c.Address         Do             c.Value = 5             Set c = .FindNext(c)         Loop While Not c Is Nothing And c.Address <> firstAddress     End If End With

 

7. 控件

7.1 调用Excel下方的状态栏 

Application.DisplayStatusBar = TrueApplication.StatusBar = "Runing..."

7.2 获取Checkbox的值

isChecked = Sheets("Sheet1").Checkbox1.Value

8. 函数

8.1 InStr( [start], string, substring, [compare] )

start：是查找的开始位置. 如果被忽略, 则从字符串首位开始查询

string：被查找的字符串

substring： 要查找的子字符串

compare：可选项。 值有以下几种

选项	值	解释
vbUseCompareOption	-1	Uses option compare
vbBinaryCompare	0	二进制比较
vbTextCompare	1	字符串比较
vbDatabaseCompare	2	在数据库基础上比较

比如：

InStr(1, "abcde", "cd")  返回值是3

InStr("abcde", "cd") 返回值是3

InStr(6, "abcdeabcde", "cd") 返回值是8

 8.2 Split(expression[, delimiter[, limit[, compare]]])

返回一个下标从零开始的一维数组，它包含指定数目的子字符串

使用Split切分后，用(UBound(mut) - LBound(mut) + 1)获取该数组的个数

 

9. 获取工作表使用的最大行数

Worksheet.UsedRange 属性

已用范围包含曾经使用过的任何单元格。例如，如果单元格“A1”包含一个值，随后您删除了该值，则单元格“A1”被视为已用。在这种情况下，UsedRange 属性将返回一个包含单元格“A1”的范围。在Excel2007中则只包含有存储值或有格式设置的单元格。

下面的代码示例使用 UsedRange 属性选择工作表上所使用的单元格的范围。该示例首先将当前工作表上 A1 至 C3 的单元格范围设置为值 23。如果该工作表可见，则该示例使用 UsedRange 属性选择所使用的单元格的

Private Sub SelectUsedRange()

    Me.Activate()

    Me.Range("A1", "C3").Value2 = 23

    If Me.Visible = Excel.XlSheetVisibility.xlSheetVisible Then

        Me.UsedRange.Select()

    End If

End Sub

判断一个工作表是否为空或取得工作表已使用区域的行、列数：

Worksheet.UsedRange 是工作表的使用到的最大范围，直接使用UsedRange的属性:

Worksheets(1).UsedRange.Row     ' 起始行

Worksheets(1).UsedRange.Column ' 起始列

Worksheets(1).UsedRange.Rows.Count   ' 行数

Worksheets(1).UsedRange.Columns.Count   ' 列数

Range.CurrentRegion 属性

当前的区域是由任意组合的空行和空列所包围的范围。此属性不适用于受保护的工作表。

(被填充的单元格块，包括当前被选中的一个单元格或者多个单元格。该区域延伸到各个方向上第一个碰到的空行或者空列)

关于CurrentRegion和UsedRange的困惑

CurrentRegion和UsedRange是很有用的,但是遇到一些极端情况,可能不那么如人意

set a = activesheet.cells.currentregion

set b= activesheet.usedrange

对于下图中的情况，除了C1:C3，A3:B3，A4外的所有格子为空（没有任何内容和格式），A4仅仅是加了特殊格式对于上述定义 a 为A1 b为A1:C4

但是我希望数据清单的范围是A1:C3 用usedrange挺好，就是怕有时候不经意在本来的数据清单的周围作了一些操作，而没有彻底清除，这样usedrange就不是想要的数据范围，进而导致程序出错或程序结果输出不理想   怎么有效地解决这个问题呢

currentregion只的是连续单元格组成的矩形区域,除了边界的单元格,一般单元格有8个相邻单元格,(下图中红线区域)

usedrange是当前工作表已经使用的单元格组成的矩形区域,设置格式也属于已经使用(下图中的兰线区域)

这两个区域有时相同,有时不同,本图中,二者结果不同的原因在于黄色区域是空白的

Range.End(xlup)

Sub GetMaxRow()

    Dim MaxRow As Long

    MaxRow = Me.Cells(1048576, 1).End(xlUp).Row

    MsgBox MaxRow

End Sub

这一程序返回工作表中最后一个包含非空内容的单元格所在的行号，而不管这一单元格与Me.Cells(1,1)之间是否有包含空白内容的单元格。而且这一方法将跳过或者说忽略被隐藏的单元格，比如，数据表有连续的50行，如果第48到50行隐藏了，则这一程序只返回47。

补救方法：

MaxRow = Application.Evaluate("=MAX((A1:A1048576<>"""")*ROW(1:1048576))") '数组公式

如果表A列中没有空行也可以:

MaxRow = Application.WorksheetFunction.CountA(Me.Columns(1))

 

Worksheet.Rows 属性

Private Sub DisplayRowCount() MsgBox("This worksheet contains " & _ Me.Rows.Count.ToString() & " rows.")End Sub

 

10. 数学函数

sgn: 符号判断，值为-1，0，1

abs: 绝对值

Atn: 反正弦

 

其他：

结束程序：

End

调试程序：

Debug.Print myRange.Row & ", " & myRange.Column。立即窗口可通过（View菜单或Ctrl+G实现）。

代码换行符:

函数换行

Function IsSheetExist(shname As String, _

name As String)

Function IsSheetExist(shname As String _

, name As String)

字符串换行

"(" _

+ .Cells(i, 1).Value + "," _

+ .Cells(i, 2).Value + ",'" _

+ .Cells(i, 3).Value + "'," _

+ .Cells(i, 4).Value + ")"

注意：下划线前一定要有空格

全局变量：

Public ar as integer

如果是常量：Public Const ar as integer = 2

如果是变量，则在某个过程中赋值。

数组:

Dim intArray(10, 10, 10) As IntegerReDim Preserve intArray(10, 10, 20)ReDim Preserve intArray(10, 10, 15)ReDim intArray(10, 10, 10)