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