VBA在Excel中的應用(一)

原文出處
http://www.cnblogs.com/jaxu/archive/2009/04/04/1407004.html


目錄

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返回活動單元格所在的周圍由空行和空列組成的單元格區域(這個似乎有點不太好理解) ,可以看下圖的示例:
    117823212可以這樣理解CurrentRegion屬性所代表的區域,即以活動單元格爲中心,它所包含的矩形區域的每一行和每一列中至少包含有一個數據,上圖中的藍色陰影區域中,無論活動單元格是哪一個,其所在的當前區域均爲同一區域,如B5:D7區域中的B5和C6單元格。A4的當前區域表示爲A1:D7,A8的當前區域表示爲A5:D11,A12的當前區域只有它本身。
    使用CurrentRegion屬性相當於在Excel工作表中選擇菜單“編輯-定位”命令,在彈出的“定位”對話框中單擊“定位條件”按鈕,然後在“定位條件”對話框中選中“當前區域”選項按鈕,或者相當於使用Ctrl+Shift+*組合鍵。在Excel2007中,該命令在以下地方可以找到:
    3-10-2009 10-20-46 AM在下拉菜單中選擇“Go To Special…” ,在對話框中選擇“Current region”。
    3-10-2009 10-27-33 AM 有關使用CurrentRegion的一些例子:
    在下圖中,要使用空白單元格上方的有數據的單元格中的數據來填充空白單元格。
    3-10-2009 10-30-05 AM
    代碼如下,
    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所在當前區域中的空白單元格被相應數據填充,如下圖。
    3-10-2009 10-30-40 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 
  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的一個例子:
    將下圖所示的數據按順序存放到一個新建的工作表中,
    3-10-2009 12-27-39 PM 
    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”的工作表中會出現如下圖所示的數據。
    3-10-2009 4-22-05 PM
  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數目不一致會發生異常。

返回目錄

發表評論
所有評論
還沒有人評論,想成為第一個評論的人麼? 請在上方評論欄輸入並且點擊發布.
相關文章