VBA在Excel中的应用（一）【转自http://www.cnblogs.com/jaxu/】

最新推荐文章于 2024-05-23 16:28:12 发布

weixin_33922672

最新推荐文章于 2024-05-23 16:28:12 发布

阅读量92

点赞数

原文链接：http://www.cnblogs.com/Godblessyou/archive/2010/07/16/1779169.html

版权

ActiveCell
ActiveWorkbook
AdvancedFilter
AutoFill

ActiveCell

1. 检查活动单元格是否存在

Sub activeCell()
If ActiveCell Is Nothing Then End If
End Sub
2. 通过指定偏移量设置活动单元格

Sub offset()
ActiveCell.Offset(RowOffset: =- 2 , ColumnOffset: = 4 ).Activate
End Sub
Offset函数的第一个参数为Row的偏移量，第二个参数为Column的偏移量（可以不指定），使用时可以直接给定值，如Offset(2, 4)。值小于0向相反方向偏移。Offset().Activate与Offset().Select在效果上等同。
3. 设置活动单元格的当前值

Sub SetValue
ActiveCell.Value = " Hello World! "
End Sub
4. 为当前活动单元格设置公式

Sub fomula()
ActiveCell.Formula = " =SUM($G$12:$G$22) "
End Sub
将公式的表达式直接赋值给Formula属性，公式表达式可以参考Excel中的公式菜单，如求和、计数、求平均值等。
5. 获取当前活动单元格的地址

Sub selectRange()
MsgBox ActiveCell.Address
End Sub
地址的格式如：$A$11。
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()
    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. 使用SpecialCells方法
该方法用于返回与指定形态和值相符合的所有单元格，其中第一个参数为xlCellType类型所代表的常数。

xlCellTypeAllFormatConditions	任何格式的单元格。
xlCellTypeAllValidation	带数据校验的单元格。
xlCellTypeBlanks	空单元格。
xlCellTypeComments	包含注释的单元格。
xlCellTypeConstants	包含常数的单元格。
xlCellTypeFormulas	包含公式的单元格。
xlCellTypeLastCell	已用范围的最后一个单元格。
xlCellTypeSameFormatConditions	有相同格式的单元格。
xlCellTypeSameValidation	有相同数据校验准则的单元格。
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. 通过Application.WorksheetFunction调用Proper方法

Sub FixText()
ActiveCell.Value = Application.WorksheetFunction.Proper( " asdf " )
End Sub
该方法将给定的表达式中的第一个字母大写，而其余字母小写，示例中的代码将活动单元格的值设置为“Asdf”。
10. EntireRow和EntireColumn

Sub SelectColumn()
ActiveCell.EntireColumn.Select
End Sub
Sub SelectRow()
ActiveCell.EntireRow.Select
End Sub
EntireColumn用于选择当前活动单元格所在的整列，EntireRow用于选择当前活动单元格所在的整行。
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()
    If TypeName (Selection) = " Range " Then
      Selection.WrapText = Not ActiveCell.WrapText
    End If
End Sub
WarpText属性用于指示当前活动单元格是否被设置为允许换行。

返回目录

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()
    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 Management Server”，在弹出的对话框中选择相应的格式对文档进行发布操作。
6. 遍历ActiveWorkbook中的表单集合
Sub Test()
    For Each Item In ActiveWorkbook.Sheets
        Debug.Print Item.name
    Next Item
End Sub
7. 关闭当前工作簿
Sub close()
ActiveWorkbook.Close SaveChanges: = False
End Sub
将当前工作簿关闭，SaveChanges为False表示不保存当前更改。
8. 保护工作簿的结构和窗体
Sub protect()
ActiveWorkbook.Protect Password: = " pass " , Structure: = True , Windows: = True
End Sub
该操作相当于在Excel2007中，选择“Review”菜单，选择“Protect Workbook”，点击“Protect Structure and Windows”操作，该代码示例中给该操作设置了一个用于还原的密码。
9. 打印工作表
Sub print()
ActiveWorkbook.Sheets( 1 ).Printout Copies: = 2 , Collate: = True
End Sub
10. 移除工作簿中的个人信息
Sub remove()
ActiveWorkbook.RemovePersonalInformation = True
End Sub
11. 为工作簿设置打开密码
Sub pass()
ActiveWorkbook.Password = " pass "
End Sub
该操作相当于在Excel2007中，点击“另存为”，在弹出的对话框中选择“工具”，点击“General Options...”，在弹出的对话框中设置用于打开工作簿的密码。
12. 为工作簿设置可写密码
Sub passWrite()
ActiveWorkbook.WritePassword = " pass "
End Sub
该操作相当于在Excel2007中，点击“另存为”，在弹出的对话框中选择“工具”，点击“General Options...”，在弹出的对话框中设置可修改工作簿的密码。
13. 在当前工作簿中打开新窗口
Sub new ()
ActiveWorkbook.Windows( 1 ).NewWindow
End Sub
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工作簿中各种不同类型的链接。

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()
ActiveSheet.DisplayPageBreaks = False
ActiveSheet.DisplayPageBreaks = True
End Sub
DisplayPageBreaks属性用于指示是否显示工作表的分页符，如果没有安装打印机，则不能设置该属性的值。

返回目录

AdvancedFilter

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. 使用AutoFill方法自动填充单元格
Sub autoFill()
Range( " F2:F13 " ).autoFill Destination: = Range( " F2:I11 " )
End Sub
用于从SourceRange填充数据到DestinationRange，可选参数xlAutoFillType常量用于指定填充数据的方式。数据填充过程中如果SourceRange和DestinationRange的Rows数目不一致会发生异常。

返回目录

转载于:https://www.cnblogs.com/Godblessyou/archive/2010/07/16/1779169.html

weixin_33922672

关注

0
点赞
踩
0

收藏

觉得还不错? 一键收藏
0
评论
VBA在Excel中的应用（一）【转自http://www.cnblogs.com/jaxu/】

目录 ActiveCell ActiveWorkbook AdvancedFilter AutoFill ActiveCell1. 检查活动单元格是否存在 Sub activeCell() If ActiveCell IsNothingThenEnd If End Sub2. 通过指定偏移量设置活动单元格 Sub offset() ActiveCel...
复制链接

扫一扫