8 Range 對象

8.1 引用Range

引用Range的主要方法：

Application.ActiveCell

Application.Range

Application.Selection

Worksheet.Cells

Worksheet.Columns

Worksheet.Range

Worksheet.Rows

Worksheet.UsedRange

CurrentRegion, NamedRange

代碼清單8.1：使用Application對象引用Range

Sub ReferringToRangesI() 
    Dim rg As Range 
     
    'ActiveCell is a range representing the 
    'active cell. there can be one and 
    'only one active cell. 
    Debug.Print Application.ActiveCell.Address 
     
    'selection refers to a range representing 
    'all of the selected cells. there can be 
    'one or more cells in the range. 
    Debug.Print Application.Selection.Address 
     
    'application.Range works on the active 
    'worksheet 
    ThisWorkbook.Worksheets(1).Activate 
    Set rg = Application.Range("D5") 
    Debug.Print "worksheets 1 is active" 
    Debug.Print rg.Address 
    Debug.Print rg.Parent.Name 
     
    ThisWorkbook.Worksheets(2).Activate 
    Set rg = Application.Range("D5") 
    Debug.Print "worksheets 2 is active" 
    Debug.Print rg.Address 
    Debug.Print rg.Parent.Name
    
    Set rg = Nothing
End Sub

 Range中地址的表示法：

Application.Range("D5") 
Application.Range("A1:C5") 
Application.Range("A:A") 
Application.Range("3:3") 
Application.Range("A1:D5","D6:F10") 

 

8.1.1 WorkSheet對象的Cells屬性和Range屬性

代碼清單8.2：使用Cells屬性指定單個的單元格

Sub UsingCells() 
    Dim rg As Range 
    Dim nRow As Integer 
    Dim nColumn As Integer 
    Dim ws As Worksheet 
     
    Set ws = ThisWorkbook.Sheets(1) 
     
    For nRow = 1 To 10 
        For nColumn = 1 To 10 
            Set rg = ws.Cells(nRow, nColumn) 
            rg.Value = rg.Address 
        Next 
    Next 
     
    Set rg = Nothing 
    Set ws = Nothing 
End Sub

 

代碼清單8.3：使用Range屬性指向單元格組

Sub UsingRange() 
    Dim ws As Worksheet 
    Dim rg As Range 
     
    Set ws = ThisWorkbook.Worksheets(1)

    'specifying a range using Cells 
    'this range is equivalent to A1:J10 
    Set rg = ws.Range(ws.Cells(1, 1), ws.Cells(10, 10)) 
    'sets the value of each cell in the range to 1 
    rg.Value = 1 
     
    Set rg = ws.Range("D4", "E5") 
    rg.Font.Bold = True 
    ws.Range("A1:B2").HorizontalAlignment = xlLeft 
     
    Set rg = Nothing 
    Set ws = Nothing 
End Sub

考慮清單8.3中的語句：

Set rg = ws.Range(ws.Cells(1, 1), ws.Cells(10, 10))

此語句依靠四個整數肯定Range引用的範圍，這4個整數是兩個對角單元格所在的行和列位置。因此特別適合動態肯定範圍。 

8.1.2 指向命名範圍多是棘手的

有兩種範圍的名稱，工做薄範圍和工做表範圍。工做薄名稱範圍必須是惟一的，而工做表範圍只須要在它們建立的工做表中是惟一的。

代碼清單8.4：使用Names對象列出全部的命名範圍

'Test the ListWorkbookNmaes procedure 
'outputs to cell A2 on the 2nd worksheet in the workbook 
Sub TestListNames() 
    ListWorkbookNames ThisWorkbook, ThisWorkbook.Worksheets(2).Range("A2") 
End Sub 

Sub ListWorkbookNames(wb As Workbook, rgListStart As Range) 
    Dim nm As Name 
    For Each nm In wb.Names 
        'print out the name of the range 
        rgListStart.Value = nm.Name 
         
        'print out what the range refers to 
        'the ' is required so that excel doesn't consider it as a formula 
        rgListStart.Offset(0, 1).Value = "'" & nm.RefersTo 
        rgListStart.Offset(0, 2).Value = "'" & nm.Value 
        rgListStart.Offset(0, 3).Value = nm.RefersToRange 
         
        'set rgListStart to refer to the cell the next row down. 
        Set rgListStart = rgListStart.Offset(1, 0) 
    Next 
End Sub 

 若是在工做表Sheet2中有一個名爲Testing的名稱，則可使用下面的語句引用這個範圍：

ThisWorkbook.Worksheets("Sheet2").Range("Testing")

可是，咱們不能從Sheet1中引用這個單元格：

'這是非法的
ThisWorkbook.Worksheets("Sheet1").Range("Testing")
'這不是非法的
ThisWorkbook.Worksheets("Sheet2").Range("Testing")

 

8.1.2.1 安全第一：在使用命名範圍以前確認他們有效

代碼清單8.5：使用過程RangeNameExists確認名稱有效

'checks for the existence of a named range on a worksheet 
Function RangeNameExists(ws As Worksheet, sName As String) As Boolean 
    Dim s As String 
    On Error GoTo ErrHandler 
    
    s = ws.Range(sName).Address 
    RangeNameExists = True 
    Exit Function
ErrHandler: 
    RangeNameExists = False
End Function 

Sub ValidateNamedRangeExample() 
    If RangeNameExists(ThisWorkbook.Worksheets(1), "Test") Then 
        MsgBox "The name exists, it refers to: " & ThisWorkbook.Names("Test").RefersTo, vbOKOnly 
    Else 
        MsgBox "the name does not exist", vbOKOnly 
    End If 
    If RangeNameExists(ThisWorkbook.Worksheets(1), "djfs") Then 
        MsgBox "The name exists, it refers to: " & ThisWorkbook.Worksheets(1).Names("djfs").RefersTo, vbOKOnly 
    Else 
        MsgBox "the name does not exist", vbOKOnly      
    End If      
End Sub 

 

8.2 找到咱們的方法

8.2.1 Offset用於相對導航

可使用Offset處理一個結構化的列表。設置列表的第一行和第一列的引用，而後循環遍歷列表，繼續引用下一行，當到達一個空行時終止循環。代碼8.6使用這個技術對列表進行過濾。

代碼清單8.6：使用Offset屬性的列表處理方法

Sub ListExample() 
    FilterYear 2000 
End Sub 

Sub Reset() 
    With ThisWorkbook.Worksheets("List Example") 
        .Rows.Hidden = False 
        .Rows.Font.Bold = False 
        .Rows(1).Font.Bold = True          
    End With 
End Sub 

Sub FilterYear(nYear As Integer) 
    Dim rg As Range 
    Dim nMileageOffset As Integer 
     
    '1st row is column header so start with 2nd row 
    Set rg = ThisWorkbook.Worksheets("List Example").Range("A2") 
    nMileageOffset = 6 
     
    'go until we bump into first empty cell 
    Do Until IsEmpty(rg) 
        If rg.Value < nYear Then 
            rg.EntireRow.Hidden = True 
        Else 
            'check milage 
            If rg.Offset(0, nMileageOffset).Value < 40000 Then 
                rg.Offset(0, nMileageOffset).Font.Bold = True 
            Else 
                rg.Offset(0, nMileageOffset).Font.Bold = False 
            End If 
            rg.EntireRow.Hidden = False 
        End If 
        'move down to the next row 
        Set rg = rg.Offset(1, 0) 
    Loop 

    Set rg = Nothing 
End Sub

 

8.2.2 最後的但不是最不重要的—找到End

Ctrl+箭頭操做是將活動單元格向箭頭方向移動到下一個末端，這裏的末端指的是連續非空區域開始或最後的單元格，算法：

若是當前單元格爲空，跳到下一個非空單元格。若是不能發現非空單元格，則跳到工做表邊界最近的單元格。

若是當前單元格非空，則查看下一個單元格是否爲空。若是爲空，則選擇下一個非空單元格，若是不能發現非空單元格，則跳到工做表邊界最近的單元格。若是非空，則選擇連續非空單元格的最後一個單元格。

End屬性返回指定單元格在指定方向上的下一個末端。

代碼清單8.7：使用End屬性在一個工做表中導航

Sub ExperimentWithEnd() 
    Dim ws As Worksheet 
    Dim rg As Range 
     
    Set ws = ThisWorkbook.Worksheets(1) 
    Set rg = ws.Cells(1, 1) 
     
    ws.Cells(1, 8).Value = "rg.address = " & rg.Address 
    ws.Cells(2, 8).Value = "rg.End(xlDown).Address = " & rg.End(xlDown).Address 
    ws.Cells(3, 8).Value = "rg.End(xlDown).End(xlDown).Address = " & rg.End(xlDown).End(xlDown).Address 
    ws.Cells(4, 8).Value = "rg.End(xlToRight).Address = " & rg.End(xlToRight).Address 
     
    Set rg = Nothing 
    Set ws = Nothing 
End Sub 

 由於End屬性返回一個Range對象，因此能夠在同一個語句中屢次使用它。

代碼8.8首先找到工做表邊界的最後單元格，而後向工做表開始方向應用End屬性。

代碼清單8.8：查找列或者行中最後使用的單元格

'returns a range object that represents the last 
'non-empty cell in the same column 
Function GetLastCellInColumn(rg As Range) As Range 
    Dim lMaxRows As Long 
     
    lMaxRows = ThisWorkbook.Worksheets(1).Rows.Count 
     
    'make sure the last cell in the column is empty 
    If IsEmpty(rg.Parent.Cells(lMaxRows, rg.Column)) Then 
        Set GetLastCellInColumn = rg.Parent.Cells(lMaxRows, rg.Column).End(xlUp) 
    Else 
        Set GetLastCellInColumn = rg.Parent.Cells(lMaxRows, rg.Column) 
    End If 
End Function 

'returns a range object that represents the last 
'non-empty cell in the same row 
Function GetLastCellInRow(rg As Range) As Range 
    Dim lMaxColumns As Long 
     
    lMaxColumns = ThisWorkbook.Worksheets(1).Columns.Count 
     
    'make sure the last cell in the row is empty 
    If IsEmpty(rg.Parent.Cells(rg.Row, lMaxColumns)) Then 
        Set GetLastCellInRow = rg.Parent.Cells(rg.Row, lMaxColumns).End(xlToLeft) 
    Else 
        Set GetLastCellInRow = rg.Parent.Cells(rg.Row, lMaxColumns) 
    End If 
End Function

 函數中的lMaxRows和lMaxColumns分別是工做表的最大行數和最大列數，這兩個值對於每一個工做表都是相同的，在Excel 2013中測試分別是1048576和16384。

而後，測試這個單元格是否爲空，若是爲空，向開始方向應用一次End屬性找到最後單元格。不然非空，這個單元格就是最後的單元格。

代碼8.9與代碼8.8基本同樣，不一樣的是代碼8.8返回單元格自己，而代碼8.9返回的是Long類型的單元格的位置。

代碼清單8.9：使用工做表可調用函數，返回列或者行中最後使用的單元格

'returns a number that represents the last 
'nonempty cell in the same column 
'callable from a worksheet 
Function GetLastUsedRow(rg As Range) As Long 
    Dim lMaxRows As Long 
     
    lMaxRows = ThisWorkbook.Worksheets(1).Rows.Count 
    'make sure the last cell in the column is empty 
    If IsEmpty(rg.Parent.Cells(lMaxRows, rg.Column)) Then 
        GetLastUsedRow = rg.Parent.Cells(lMaxRows, rg.Column).End(xlUp).Row 
    Else 
        GetLastUsedRow = rg.Parent.Cells(lMaxRows, rg.Column).Row 
    End If 
     
End Function 

'returns a number that represents the last 
'nonempty cell in the same row 
'callable from a worksheet 
Function GetLastUsedColumn(rg As Range) As Long 
    Dim lMaxColumns As Long 
     
    lMaxColumns = ThisWorkbook.Worksheets(1).Columns.Count 
    If IsEmpty(rg.Parent.Cells(rg.Row, lMaxColumns)) Then 
        GetLastUsedColumn = rg.Parent.Cells(rg.Row, lMaxColumns).End(xlToLeft).Column 
    Else 
        GetLastUsedColumn = rg.Parent.Cells(rg.Row, lMaxColumns).Column 
    End If 
End Function

 

8.3 輕鬆輸入；輕鬆輸出

8.3.1 輸出策略

代碼清單8.10是一個僵化程序的反面教材。

代碼清單8.10：提防包含了許多說明性文字範圍的過程

'this is procedures are generally error prone 
'and unnecessarily difficult to maintain/modify 
Sub RigidFormattingProcedure() 
    'Activate Test Report worksheet 
    ThisWorkbook.Worksheets("Test Report").Activate 
    'make text in first column bold 
    ActiveSheet.Range("A:A").Font.Bold = True 
    'widen first column to display text 
    ActiveSheet.Range("A:A").EntireColumn.AutoFit 
    'format date on report 
    ActiveSheet.Range("A2").NumberFormat = "mmm-yy" 
    'Make column headings bold 
    ActiveSheet.Range("6:6").Font.Bold = True 
     
    'add & format totals 
    ActiveSheet.Range("N7:N15").Formula = "=sum(rc[-12]:rc[-1])" 
    ActiveSheet.Range("N7:N15").Font.Bold = True 
     
    ActiveSheet.Range("B16:N16").Formula = "=sum(r[-9]c:r[-1]c)" 
    ActiveSheet.Range("B16:N16").Font.Bold = True 
     
    'format data range 
    ActiveSheet.Range("B7:N16").NumberFormat = "#,##0"      
End Sub 

使用命名範圍的好處是，若是插入或刪除行或列，命名範圍受到更少的影響。由於命名範圍會自動調整它的RefersTo。

一個結構化的計算框架是，找到一個單元格做爲相對定位的基準，並命名它。而後，使用Offset來相對基準位置操做其餘單元格。這樣，只要保證這個框架單元格相對位置不變，就能夠靈活的移動它，而且不須要修改VBA代碼。

代碼8.11假定已在工做薄"Test Report"中定義以下的名稱：
REPORT_TITLE
REPORT_DATE
COLUMN_HEADING
ROW_HEADING
DATA
COLUMN_TOTAL
ROW_TOTAL

代碼清單8.11：一個更加靈活的處理結構化範圍的過程

Sub RigidProcedureDeRigidized() 
    Dim ws As Worksheet 
    If Not WorksheetExists(ThisWorkbook, "Test Report") Then 
        MsgBox "Can't find required worksheet 'Test Report'", vbOKOnly 
        Exit Sub 
    End If 
    Set ws = ThisWorkbook.Worksheets("Test Report") 

    If RangeNameExists(ws, "REPORT_TITLE") Then 
        ws.Range("REPORT_TITLE").Font.Bold = True 
    End If 
     
    If RangeNameExists(ws, "REPORT_DATE") Then 
        With ws.Range("REPORT_DATE") 
            .Font.Bold = True 
            .NumberFormat = "mmm-yy" 
            .EntireColumn.AutoFit 
        End With 
    End If 
     
    If RangeNameExists(ws, "ROW_HEADING") Then 
        ws.Range("ROW_HEADING").Font.Bold = True 
    End If 
     
    If RangeNameExists(ws, "COLUMN_HEADING") Then 
        ws.Range("COLUMN_HEADING").Font.Bold = True 
    End If 
     
    If RangeNameExists(ws, "DATA") Then 
        ws.Range("DATA").NumberFormat = "#,##0" 
    End If 
     
    If RangeNameExists(ws, "COLUMN_TOTAL") Then 
        With ws.Range("COLUMN_TOTAL") 
            .Formula = "=SUM(R[-9]C:R[-1]C)" 
            .Font.Bold = True 
            .NumberFormat = "#,##0" 
        End With 
    End If 
     
    If RangeNameExists(ws, "ROW_TOTAL") Then 
        With ws.Range("ROW_TOTAL") 
            .Formula = "=SUM(RC[-12]:RC[-1])" 
            .Font.Bold = True 
            .NumberFormat = "#,##0" 
        End With 
    End If 
         
    Set ws = Nothing 
End Sub 

 

8.3.2 接受工做表輸入

代碼清單8.12：確認一個有正確數據的範圍 

Function ReadCurrencyCell(rg As Range) As Currency 
    Dim cValue As Currency 
    cValue = 0 
     
    On Error GoTo ErrHandler 
     
    If IsEmpty(rg) Then GoTo ExitFunction 
    If Not IsNumeric(rg) Then GoTo ExitFunction 
     
    cValue = rg.Value 
 
ExitFunction: 
    ReadCurrencyCell = cValue 
    Exit Function 
 
ErrHandler: 
    ReadCurrencyCell = 0 
End Function