VBA在Excel中的应用(一)
目录
 ActiveCell
 ActiveCell ActiveWorkbook
 ActiveWorkbook AdvancedFilter
 AdvancedFilter AutoFill
 AutoFill
ActiveCell
- 1. 检查活动单元格是否存在
 Sub activeCell()
 If ActiveCell Is Nothing Then End If
 End Sub
- 2. 通过指定偏移量设置活动单元格
 Sub offset()Offset函数的第一个参数为Row的偏移量,第二个参数为Column的偏移量(可以不指定),使用时可以直接给定值,如Offset(2, 4)。值小于0向相反方向偏移。Offset().Activate与Offset().Select在效果上等同。
 ActiveCell.Offset(RowOffset:=-2, ColumnOffset:=4).Activate
 End Sub
- 3. 设置活动单元格的当前值
 Sub SetValue
 ActiveCell.Value = "Hello World!"
 End Sub
- 4. 为当前活动单元格设置公式
 Sub fomula()将公式的表达式直接赋值给Formula属性,公式表达式可以参考Excel中的公式菜单,如求和、计数、求平均值等。
 ActiveCell.Formula = "=SUM($G$12:$G$22)"
 End Sub
- 5. 获取当前活动单元格的地址
 Sub selectRange()地址的格式如:$A$11。
 MsgBox ActiveCell.Address
 End Sub
- 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. 当前活动单元格所在区域选择 
 Sub SelectCurrentRegion()对CurrentRegion属性所代表的区域的说明:
 ActiveCell.CurrentRegion.Select
 End Sub
 CurrentRegion返回活动单元格所在的周围由空行和空列组成的单元格区域(这个似乎有点不太好理解) ,可以看下图的示例:![117823212 117823212]() 可以这样理解CurrentRegion属性所代表的区域,即以活动单元格为中心,它所包含的矩形区域的每一行和每一列中至少包含有一个数据,上图中的蓝色阴影区域中,无论活动单元格是哪一个,其所在的当前区域均为同一区域,如B5:D7区域中的B5和C6单元格。A4的当前区域表示为A1:D7,A8的当前区域表示为A5:D11,A12的当前区域只有它本身。 可以这样理解CurrentRegion属性所代表的区域,即以活动单元格为中心,它所包含的矩形区域的每一行和每一列中至少包含有一个数据,上图中的蓝色阴影区域中,无论活动单元格是哪一个,其所在的当前区域均为同一区域,如B5:D7区域中的B5和C6单元格。A4的当前区域表示为A1:D7,A8的当前区域表示为A5:D11,A12的当前区域只有它本身。
 使用CurrentRegion属性相当于在Excel工作表中选择菜单“编辑-定位”命令,在弹出的“定位”对话框中单击“定位条件”按钮,然后在“定位条件”对话框中选中“当前区域”选项按钮,或者相当于使用Ctrl+Shift+*组合键。在Excel2007中,该命令在以下地方可以找到:![3-10-2009 10-20-46 AM 3-10-2009 10-20-46 AM]() 在下拉菜单中选择“Go To Special…” ,在对话框中选择“Current region”。 在下拉菜单中选择“Go To Special…” ,在对话框中选择“Current region”。![3-10-2009 10-27-33 AM 3-10-2009 10-27-33 AM]() 有关使用CurrentRegion的一些例子: 有关使用CurrentRegion的一些例子:
  在下图中,要使用空白单元格上方的有数据的单元格中的数据来填充空白单元格。![3-10-2009 10-30-05 AM 3-10-2009 10-30-05 AM]() 
 代码如下,Sub FillBlankCells()执行之后,工作表中单元格A1所在当前区域中的空白单元格被相应数据填充,如下图。
 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![3-10-2009 10-30-40 AM 3-10-2009 10-30-40 AM]()  
 ‚ 如下图,对第三列进行降序排序。![3-10-2009 10-31-06 AM 3-10-2009 10-31-06 AM]()  
 代码如下: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![3-10-2009 10-31-22 AM 3-10-2009 10-31-22 AM]()  
- 8. 使用SpecialCells方法
 该方法用于返回与指定形态和值相符合的所有单元格,其中第一个参数为xlCellType类型所代表的常数。第二个参数为可选参数。如果xlCellType为xlCellTypeConstants或xlCellTypeFormulas 之一,该参数用于确定结果中应包含哪些类型的单元格。将某几个值相加可使此方法返回多种形态的单元格。默认情况下将指定所有常数或公式,对其形态则不加类型。它可以是下列常数之一。xlCellTypeAllFormatConditions 任何格式的单元格。 xlCellTypeAllValidation 带数据校验的单元格。 xlCellTypeBlanks 空单元格。 xlCellTypeComments 包含注释的单元格。 xlCellTypeConstants 包含常数的单元格。 xlCellTypeFormulas 包含公式的单元格。 xlCellTypeLastCell 已用范围的最后一个单元格。 xlCellTypeSameFormatConditions 有相同格式的单元格。 xlCellTypeSameValidation 有相同数据校验准则的单元格。 xlCellTypeVisible 所有可见单元格。 
 xlErrors
 xlLogical
 xlNumbers
 xlTextValues
 Sub SelectActiveArea()有关使用SpecialCells的一个例子:
 Range(Range("A1"), ActiveCell.SpecialCells(xlTypeLastCell)).Select
 End Sub
 将下图所示的数据按顺序存放到一个新建的工作表中,![3-10-2009 12-27-39 PM 3-10-2009 12-27-39 PM]() Sub toAcol()执行后,在名称为“newSht4”的工作表中会出现如下图所示的数据。 Sub toAcol()执行后,在名称为“newSht4”的工作表中会出现如下图所示的数据。
 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![3-10-2009 4-22-05 PM 3-10-2009 4-22-05 PM]() 
- 9. 通过Application.WorksheetFunction调用Proper方法
 Sub FixText()该方法将给定的表达式中的第一个字母大写,而其余字母小写,示例中的代码将活动单元格的值设置为“Asdf”。
 ActiveCell.Value = Application.WorksheetFunction.Proper("asdf")
 End Sub
- 10. EntireRow和EntireColumn
 Sub SelectColumn()EntireColumn用于选择当前活动单元格所在的整列,EntireRow用于选择当前活动单元格所在的整行。
 ActiveCell.EntireColumn.Select
 End Sub
 Sub SelectRow()
 ActiveCell.EntireRow.Select
 End Sub
- 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. WarpText属性
 Sub ToggleWrapText()WarpText属性用于指示当前活动单元格是否被设置为允许换行。
 If TypeName(Selection) = "Range" Then
 Selection.WrapText = Not ActiveCell.WrapText
 End If
 End Sub
ActiveWorkbook
- 1. 获取当前活动工作簿的名称
Sub test()
 MsgBox ActiveWorkbook.FullName
 End Sub
- 2. 打开工作表
Sub filePath()
 Dim filePath As String
 filePath = ActiveWorkbook.Path
 Workbooks.Open (filePath & "\" & "MyWorkbook.xls")
 End Sub
- 3. 保存工作表
Sub webPage()
 ActiveWorkbook.SaveAs _
 Filename:=ActiveWorkbook.Path & "\myXclfile.htm", _
 FileFormat:=xlHtml
 End Sub
- 4. 预览工作表
Sub pre()
 ActiveWorkbook.WebPagePreview
 End Sub
- 5. 发布Excel文件到指定的目录
Public Sub SaveRangeWeb()上述代码可以将当前工作簿中所选择的区域以htm文件的格式发布到一个指定的目录中,该目录可以是本地目录,也可以是远程服务器上的目录,或者是Sharepoint中的一个特定的Folder。Publish方法的参数为True表示如果目标地址的文件存在则替换,为False表示如果目标地址的文件存在则追加。AutoRepublish方法的参数用于指示当Excel文件保存的时候是否自动重新发布。
 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
 在Excel2007中,相当于点击窗体左上角的Office按钮,选择“发布”,点击“Document Management Server”,在弹出的对话框中选择相应的格式对文档进行发布操作。
- 6. 遍历ActiveWorkbook中的表单集合
Sub Test()
 For Each Item In ActiveWorkbook.Sheets
 Debug.Print Item.name
 Next Item
 End Sub
- 7. 关闭当前工作簿
Sub close()将当前工作簿关闭,SaveChanges为False表示不保存当前更改。
 ActiveWorkbook.Close SaveChanges:=False
 End Sub
- 8. 保护工作簿的结构和窗体
Sub protect()该操作相当于在Excel2007中,选择“Review”菜单,选择“Protect Workbook”,点击“Protect Structure and Windows”操作,该代码示例中给该操作设置了一个用于还原的密码。
 ActiveWorkbook.Protect Password:="pass", Structure:=True, Windows:=True
 End Sub
- 9. 打印工作表
Sub print()
 ActiveWorkbook.Sheets(1).Printout Copies:=2, Collate:=True
 End Sub
- 10. 移除工作簿中的个人信息
Sub remove()
 ActiveWorkbook.RemovePersonalInformation = True
 End Sub
- 11. 为工作簿设置打开密码
Sub pass()该操作相当于在Excel2007中,点击“另存为”,在弹出的对话框中选择“工具”,点击“General Options...”,在弹出的对话框中设置用于打开工作簿的密码。
 ActiveWorkbook.Password = "pass"
 End Sub
- 12. 为工作簿设置可写密码
Sub passWrite()该操作相当于在Excel2007中,点击“另存为”,在弹出的对话框中选择“工具”,点击“General Options...”,在弹出的对话框中设置可修改工作簿的密码。
 ActiveWorkbook.WritePassword = "pass"
 End Sub
- 13. 在当前工作簿中打开新窗口
Sub new()
 ActiveWorkbook.Windows(1).NewWindow
 End Sub
- 14. 通过编程方式查找遍历工作簿当中的所有链接
Sub PrintSimpleLinkInfo()xlLink为一组常量,代表了Excel工作簿中各种不同类型的链接。
 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
 xlExcelLinks 指向Excel工作表。 xlOLELinks 指向OLE数据源。 xlPublishers Macintosh使用。 xlSubscribers Macintosh使用。 
- 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
- 1. 改变当前工作表的名称
Sub changeName()
 ActiveSheet.name = "My Sheet"
 End Sub
- 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. 使用Copy和Paste方法
Sub copy()单元格拷贝时会同时拷贝该单元格的内容、格式以及公式等信息。
 Cells(2, "B").copy
 Range("B2:B10").Select
 ActiveSheet.Paste
 End Sub
- 4. 对工作表设置密码
Sub protect()
 ActiveWorksheet.Protect Password:="pass"
 End Sub
 Sub protects()
 ActiveWorksheet.Protect Password:="pass", AllowFormattingCells:=True, _
 AllowSorting:=True
 End Sub
- 5. 设置工作表的DisplayPageBreaks属性
Sub Main()DisplayPageBreaks属性用于指示是否显示工作表的分页符,如果没有安装打印机,则不能设置该属性的值。
 ActiveSheet.DisplayPageBreaks = False
 ActiveSheet.DisplayPageBreaks = True
 End Sub
AdvancedFilter
- 1. 使用AdvancedFilter
Sub UniqueCustomerRedux()AdvancedFilter的使用类似于在Excel2007中“Data”菜单下“Sort&Filter”分类中的“Advanced”菜单的功能,其中xlFilterAction常量用于指定如何对数据进行Filter。
 Range("J1").Value = Range("D1").Value
 Range("A1").CurrentRegion.AdvancedFilter xlFilterCopy, CopyToRange:=Range("J1"), Unique:=True
 End Sub
AutoFill
- 1. 使用AutoFill方法自动填充单元格
Sub autoFill()用于从SourceRange填充数据到DestinationRange,可选参数xlAutoFillType常量用于指定填充数据的方式。数据填充过程中如果SourceRange和DestinationRange的Rows数目不一致会发生异常。
 Range("F2:F13").autoFill Destination:=Range("F2:I11")
 End Sub
 
                    
                     
                    
                 
                    
                










 返回目录
 返回目录 
                
            
         
         浙公网安备 33010602011771号
浙公网安备 33010602011771号