VBA在Excel中的应用（一）

1. 1. 检查活动单元格是否存在 Sub activeCell()

If ActiveCell Is Nothing Then End If End Sub

2. 2. 通过指定偏移量设置活动单元格 Sub offset()

ActiveCell.Offset(RowOffset:=-2, ColumnOffset:=4).Activate End Sub

Offset函数的第⼀个参数为Row的偏移量，第⼆个参数为Column的偏移量（可以不指定），使⽤时可以直接给定值，如Offset(2, 4)。值⼩于0向相反⽅向偏移。Offset().Activate与Offset().Select在效果上等同。

3. 3. 设置活动单元格的当前值 Sub SetValue

ActiveCell.Value = \"Hello World!\" End Sub

4. 4. 为当前活动单元格设置公式 Sub fomula()

ActiveCell.Formula = \"=SUM($G$12:$G$22)\" End Sub

将公式的表达式直接赋值给Formula属性，公式表达式可以参考Excel中的公式菜单，如求和、计数、求平均值等。

5. 5. 获取当前活动单元格的地址 Sub selectRange()

MsgBox ActiveCell.Address End Sub

地址的格式如：$A$11。

6. 6. 获取从当前活动单元格开始到边界单元格的区域' 从当前单元格到最顶端 Sub SelectUp()

Range(ActiveCell, ActiveCell.End(xlUp)).Select End Sub

'从当前单元格到最底端 Sub SelectDown()

Range(ActiveCell, ActiveCell.End(xlDown)).Select End Sub

'从当前单元格到最右端（等同于xlEnd） Sub SelectToRight()

Range(ActiveCell, ActiveCell.End(xlToRight)).Select End Sub

'从当前单元格到最左端 Sub SelectToLeft()

Range(ActiveCell, ActiveCell.End(xlToLeft)).Select End Sub

7. 7. 当前活动单元格所在区域选择 Sub SelectCurrentRegion()

ActiveCell.CurrentRegion.Select End Sub

对CurrentRegion属性所代表的区域的说明：

CurrentRegion返回活动单元格所在的周围由空⾏和空列组成的单元格区域（这个似乎有点不太好理解） ，可以看下图的⽰例：

可以这样理解CurrentRegion属性所代表的区域，即以活动单元格为中⼼，它所包含的矩形区域的每⼀⾏和每⼀列中⾄少包含有⼀个数据，上图中的蓝⾊阴影区域中，⽆论活动单元格是哪⼀个，其所在的当前区域均为同⼀区域，如B5:D7区域中的B5和C6单元格。A4的当前区域表⽰为A1:D7，A8的当前区域表⽰为A5:D11，A12的当前区域只有它本⾝。

使⽤CurrentRegion属性相当于在Excel⼯作表中选择菜单“编辑-定位”命令，在弹出的“定位”对话框中单击“定位条件”按钮，然后在“定位条件”对话框中选中“当前区域”选项按钮，或者相当于使⽤Ctrl+Shift+*组合键。在Excel2007中，该命令在以下地⽅可以找到：

在下拉菜单中选择“Go To Special…” ，在对话框中选择“Current region”。

有关使⽤CurrentRegion的⼀些例⼦：

在下图中，要使⽤空⽩单元格上⽅的有数据的单元格中的数据来填充空⽩单元格。

代码如下，

Sub FillBlankCells()

Worksheets(\"sheet1\").Range(\"A1\").CurrentRegion.SpecialCells(xlCellTypeBlanks).FormulaR1C1= \"=R[-1]C\"

Worksheets(\"sheet1\").Range(\"A1\").CurrentRegion.Value =Worksheets(\"sheet1\").Range(\"A1\").CurrentRegion.Value End Sub

执⾏之后，⼯作表中单元格A1所在当前区域中的空⽩单元格被相应数据填充，如下图。

如下图，对第三列进⾏降序排序。

代码如下：Sub testSort()

Dim rng As Range

Set rng = Worksheets(\"sheet1\").Cells(1, 1).CurrentRegion

rng.Sort Key1:=rng.Cells(1, 3), Order1:=xlDescending, Header:=xlYes End Sub

执⾏之后，⼯作表中的数据将按照第三列的数据降序排序，如下图。

8. 8. 使⽤SpecialCells⽅法

该⽅法⽤于返回与指定形态和值相符合的所有单元格，其中第⼀个参数为xlCellType类型所代表的常数。

xlCellTypeAllFormatConditionsxlCellTypeAllValidationxlCellTypeBlanksxlCellTypeCommentsxlCellTypeConstantsxlCellTypeFormulasxlCellTypeLastCell

xlCellTypeSameFormatConditionsxlCellTypeSameValidation

任何格式的单元格。带数据校验的单元格。空单元格。包含注释的单元格。包含常数的单元格。包含公式的单元格。已⽤范围的最后⼀个单元格。有相同格式的单元格。有相同数据校验准则的单元格。

xlCellTypeVisible所有可见单元格。

第⼆个参数为可选参数。如果xlCellType为xlCellTypeConstants或xlCellTypeFormulas 之⼀，该参数⽤于确定结果中应包含哪些类型的单元格。将某⼏个值相加可使此⽅法返回多种形态的单元格。默认情况下将指定所有常数或公式，对其形态则不加类型。它可以是下列常数之⼀。

xlErrors xlLogical xlNumbers xlTextValues

Sub SelectActiveArea()

Range(Range(\"A1\"), ActiveCell.SpecialCells(xlTypeLastCell)).Select End Sub

有关使⽤SpecialCells的⼀个例⼦：

将下图所⽰的数据按顺序存放到⼀个新建的⼯作表中，

Sub toAcol()

Dim newSht As Worksheet Dim Rng As Range Dim allDat As Range Dim pt As Range Dim i As Long

'选择⼯作表中所有有内容的单元格

Set allDat = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants) '新增⼯作表󰀀󰀀󰀀

Set newSht = Worksheets.Add '设置新⼯作表中的起始位置󰀀󰀀 Set pt = newSht.Range(\"a1\") For Each Rng In allDat.Areas For i = 1 To Rng.Cells.Count pt = Rng.Cells(i)

Set pt = pt.Offset(1, 0) Next Next

'重命名新⼯作表

newSht.Name = \"newSht\" & Worksheets.Count End Sub

执⾏后，在名称为“newSht4”的⼯作表中会出现如下图所⽰的数据。

9. 9. 通过Application.WorksheetFunction调⽤Proper⽅法 Sub FixText()

ActiveCell.Value = Application.WorksheetFunction.Proper(\"asdf\") End Sub

该⽅法将给定的表达式中的第⼀个字母⼤写，⽽其余字母⼩写，⽰例中的代码将活动单元格的值设置为“Asdf”。

10. 10. EntireRow和EntireColumn

Sub SelectColumn()

ActiveCell.EntireColumn.Select End Sub

Sub SelectRow()

ActiveCell.EntireRow.Select End Sub

EntireColumn⽤于选择当前活动单元格所在的整列，EntireRow⽤于选择当前活动单元格所在的整⾏。

11. 11. 找出当前所选区域中包含最⼤值的单元格

Sub GoToMax()

Dim WorkRange As Range

If TypeName(Selection) <> \"Range\" Then Exit Sub

If Selection.Count = 1 Then Set WorkRange = Cells Else

Set WorkRange = Selection End If

MaxVal = Application.Max(WorkRange)

On Error Resume Next

WorkRange.Find(What:=MaxVal, _ After:=WorkRange.Range(\"A1\"), _ LookIn:=xlValues, _ LookAt:=xlPart, _

SearchOrder:=xlByRows, _

SearchDirection:=xlNext, MatchCase:=False).Select

If Err <> 0 Then MsgBox \"Max value was not found: \" & MaxVal End Sub

12. 12. WarpText属性

Sub ToggleWrapText()

If TypeName(Selection) = \"Range\" Then

Selection.WrapText = Not ActiveCell.WrapText End If End Sub

WarpText属性⽤于指⽰当前活动单元格是否被设置为允许换⾏。

返回⽬录ActiveWorkbook

1. 1. 获取当前活动⼯作簿的名称Sub test()

MsgBox ActiveWorkbook.FullName End Sub

2. 2. 打开⼯作表Sub filePath()

Dim filePath As String

filePath = ActiveWorkbook.Path

Workbooks.Open (filePath & \"\\\" & \"MyWorkbook.xls\") End Sub

3. 3. 保存⼯作表Sub webPage()

ActiveWorkbook.SaveAs _

Filename:=ActiveWorkbook.Path & \"\\myXclfile.htm\", _ FileFormat:=xlHtml

End Sub

4. 4. 预览⼯作表Sub pre()

ActiveWorkbook.WebPagePreview End Sub

5. 5. 发布Excel⽂件到指定的⽬录

Public Sub SaveRangeWeb()

ActiveWorkbook.PublishObjects.Add _ SourceType:=xlSourceRange, _

Filename:=ActiveWorkbook.Path & \"\\Sample1.htm\", _ Sheet:=ActiveSheet.name, _ Source:=\"$A$1:$B$11\", _ HtmlType:=xlHtmlStatic

ActiveWorkbook.PublishObjects(1).Publish (True)

ActiveWorkbook.PublishObjects(1).AutoRepublish (False) End Sub

上述代码可以将当前⼯作簿中所选择的区域以htm⽂件的格式发布到⼀个指定的⽬录中，该⽬录可以是本地⽬录，也可以是远程服务器上的⽬录，或者是Sharepoint中的⼀个特定的Folder。Publish⽅法的参数为True表⽰如果⽬标地址的⽂件存在则替换，为False表⽰如果⽬标地址的⽂件存在则追加。AutoRepublish⽅法的参数⽤于指⽰当Excel⽂件保存的时候是否⾃动重新发布。

在Excel2007中，相当于点击窗体左上⾓的Office按钮，选择“发布”，点击“Document ManagementServer”，在弹出的对话框中选择相应的格式对⽂档进⾏发布操作。6. 6. 遍历ActiveWorkbook中的表单集合Sub Test()

For Each Item In ActiveWorkbook.Sheets Debug.Print Item.name Next Item End Sub

7. 7. 关闭当前⼯作簿Sub close()

ActiveWorkbook.Close SaveChanges:=False End Sub

将当前⼯作簿关闭，SaveChanges为False表⽰不保存当前更改。8. 8. 保护⼯作簿的结构和窗体Sub protect()

ActiveWorkbook.Protect Password:=\"pass\", Structure:=True, Windows:=True End Sub

该操作相当于在Excel2007中，选择“Review”菜单，选择“Protect Workbook”，点击“ProtectStructure and Windows”操作，该代码⽰例中给该操作设置了⼀个⽤于还原的密码。9. 9. 打印⼯作表Sub print()

ActiveWorkbook.Sheets(1).Printout Copies:=2, Collate:=True End Sub

10. 10. 移除⼯作簿中的个⼈信息

Sub remove()

ActiveWorkbook.RemovePersonalInformation = True End Sub

11. 11. 为⼯作簿设置打开密码

Sub pass()

ActiveWorkbook.Password = \"pass\" End Sub

该操作相当于在Excel2007中，点击“另存为”，在弹出的对话框中选择“⼯具”，点击“GeneralOptions...”，在弹出的对话框中设置⽤于打开⼯作簿的密码。12. 12. 为⼯作簿设置可写密码

Sub passWrite()

ActiveWorkbook.WritePassword = \"pass\" End Sub

该操作相当于在Excel2007中，点击“另存为”，在弹出的对话框中选择“⼯具”，点击“GeneralOptions...”，在弹出的对话框中设置可修改⼯作簿的密码。13. 13. 在当前⼯作簿中打开新窗⼝

Sub new()

ActiveWorkbook.Windows(1).NewWindow End Sub

14. 14. 通过编程⽅式查找遍历⼯作簿当中的所有链接

Sub PrintSimpleLinkInfo() Dim avLinks As Variant Dim nIndex As Integer Dim wb As Workbook Set wb = ActiveWorkbook

avLinks = wb.LinkSources(xlExcelLinks) If Not IsEmpty(avLinks) Then

For nIndex = 1 To UBound(avLinks)

Debug.Print \"Link found to '\" & avLinks(nIndex) & \"'\" Next nIndex Else

Debug.Print \"The workbook '\" & wb.name & \"' doesn't have any links.\" End If End Sub

xlLink为⼀组常量，代表了Excel⼯作簿中各种不同类型的链接。

xlExcelLinksxlOLELinksxlPublishers

xlSubscribers

15. 15. ⼯作簿常⽤属性使⽤

Sub TestPrintGeneralWBInfo() Dim wb As Workbook Set wb = ActiveWorkbook

Debug.Print \"Name: \" & wb.name

Debug.Print \"Full Name: \" & wb.FullName Debug.Print \"Code Name: \" & wb.CodeName Debug.Print \"Path: \" & wb.Path If wb.ReadOnly Then

Debug.Print \"The workbook has been opened as read-only.\" Else

Debug.Print \"The workbook is read-write.\" End If

If wb.Saved Then

Debug.Print \"The workbook does not need to be saved.\" Else

Debug.Print \"The workbook should be saved.\" End If End Sub

返回⽬录ActiveWorksheet

指向Excel⼯作表。指向OLE数据源。Macintosh使⽤。Macintosh使⽤。

1. 1. 改变当前⼯作表的名称Sub changeName()

ActiveSheet.name = \"My Sheet\" End Sub

2. 2. 向当前⼯作表添加超链接

Public Sub AddHyperlink()

ActiveSheet.Hyperlinks.Add _ Anchor:=Range(\"A1\"), _ Address:=\"\", _

SubAddress:=\"'Sheet1'!A1\", _ ScreenTip:=\" Goes to Sheet1\", _ TextToDisplay:=\" Link to Sheet1\" End Sub

3. 3. 使⽤Copy和Paste⽅法Sub copy()

Cells(2, \"B\").copy

Range(\"B2:B10\").Select ActiveSheet.Paste End Sub

单元格拷贝时会同时拷贝该单元格的内容、格式以及公式等信息。4. 4. 对⼯作表设置密码

Sub protect()

ActiveWorksheet.Protect Password:=\"pass\" End Sub

Sub protects()

ActiveWorksheet.Protect Password:=\"pass\", AllowFormattingCells:=True, _ AllowSorting:=True End Sub

5. 5. 设置⼯作表的DisplayPageBreaks属性Sub Main()

ActiveSheet.DisplayPageBreaks = False ActiveSheet.DisplayPageBreaks = True End Sub

DisplayPageBreaks属性⽤于指⽰是否显⽰⼯作表的分页符，如果没有安装打印机，则不能设置该属性的值。

返回⽬录AdvancedFilter

1. 1. 使⽤AdvancedFilter

Sub UniqueCustomerRedux()

Range(\"J1\").Value = Range(\"D1\").Value

Range(\"A1\").CurrentRegion.AdvancedFilter xlFilterCopy, CopyToRange:=Range(\"J1\"),Unique:=True End Sub

AdvancedFilter的使⽤类似于在Excel2007中“Data”菜单下“Sort&Filter”分类中的“Advanced”菜单的功能，其中xlFilterAction常量⽤于指定如何对数据进⾏Filter。

返回⽬录AutoFill

1. 1. 使⽤AutoFill⽅法⾃动填充单元格Sub autoFill()

Range(\"F2:F13\").autoFill Destination:=Range(\"F2:I11\") End Sub

⽤于从SourceRange填充数据到DestinationRange，可选参数xlAutoFillType常量⽤于指定填充数据的⽅式。数据填充过程中如果SourceRange和DestinationRange的Rows数⽬不⼀致会发⽣异常。