VBA在Excel中的应用（一）

目录

 ActiveCell 
 ActiveWorkbook 
 AdvancedFilter 
 AutoFill

ActiveCell

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类型所代表的常数。

   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. 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 Management Server”，在弹出的对话框中选择相应的格式对文档进行发布操作。
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”，点击“Protect Structure 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中，点击“另存为”，在弹出的对话框中选择“工具”，点击“General Options...”，在弹出的对话框中设置用于打开工作簿的密码。
12. 12. 为工作簿设置可写密码
    Sub  passWrite() 
        ActiveWorkbook.WritePassword  =   " pass "  
    End Sub
    该操作相当于在Excel2007中，点击“另存为”，在弹出的对话框中选择“工具”，点击“General Options...”，在弹出的对话框中设置可修改工作簿的密码。
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工作簿中各种不同类型的链接。 
    

    xlExcelLinks	指向Excel工作表。
    xlOLELinks	指向OLE数据源。
    xlPublishers	Macintosh使用。
    xlSubscribers	Macintosh使用。

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

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数目不一致会发生异常。

 返回目录

本文转自Jaxu博客园博客，原文链接：http://www.cnblogs.com/jaxu/archive/2009/04/04/1407004.html，如需转载请自行联系原作者