本类文章的标签为 ‘Range对象’

Page 1 of 212

自动生成每月的仓储费用报表

2009年09月30日, 12:51 下午
1 颗星2 颗星3 颗星4 颗星5 颗星 (1 人投票, 平均: 5.00 out of 5)
Loading ... Loading ...

这是EH论坛中的一个求助贴子：《请问如何计算仓储费》，其要求为：

我现在的问题是：我公司有仓储业务这一块，客户的煤堆放在我司仓库，我们向客户收取仓储费，每吨每天收取0.25元，如6-1日进货439.34吨，那么6-1日的仓储费就是439.34吨*0.25元*1天=109.84元，6-3日出货200吨，那么6-3日当天的仓储费是（439.34-200）*0.25*1=59.84元，客户的煤出入库频繁，每个月计算仓储费和打对帐单（对帐单需要当日明细）都够我头痛了，也不知道我表达清楚没有？我已上传附件，烦请论坛的朋友帮忙看下呵！
又：现在又有一个新的问题出来了，如果我新增了客户又该怎么样去实现呢？原来的永红是0.25元/天，新增的客户今店是0.2元/天，我们现在已经有二十多个客户，而且每个客户的仓储费在0.25元/天的基础上会略有浮动，不知道这种情况也可以实现吗？详情请见附件，烦请再出手相助呵！

花了点时间，初步实现了所要求的功能，大致思路为：
首先在MainPro过程中判断“出入库表”中有几个客户，然后将每个客户的数据存储在单元格区域对象变量中，将该变量作为参数传递到计算仓储量的CalculateFill过程中，该过程计算每个客户在规定时间每天的仓储量，然后使用CalculateResult过程计算仓储费。
具体程序代码如下：

Sub MainPro()
 
    '完全清除仓储费工作表中已有的数据
    Dim lLastRow1 As Long
    lLastRow1 = wksCal.Range("A65536").End(xlUp).Row
    If lLastRow1 >= 2 Then wksCal.Range("A2:D" & lLastRow1).ClearContents
 
    '找到出入库表中不同数据开始的行号
    Dim lRows() As Long, lLastRow2 As Long, i As Long
    Dim rng As Range
    i = 1
    ReDim Preserve lRows(1 To i)
    lRows(i) = 4
    Set rng = wksInfo.Range("B4")
    Do Until rng.Offset(1, 0) = ""
        If rng <> rng.Offset(1, 0) Then
            i = i + 1
            ReDim Preserve lRows(1 To i)
            lRows(i) = rng.Offset(1, 0).Row
        End If
        Set rng = rng.Offset(1, 0)
    Loop
 
    Set rng = Nothing
 
    lLastRow2 = wksInfo.Range("A65536").End(xlUp).Row
    '没有数据则退出
    If lLastRow2 = 3 Then Exit Sub
 
    '传递区域进行填充
    Dim rngPass As Range
    If UBound(lRows) > 1 Then
        For i = 1 To UBound(lRows) - 1
            Set rngPass = wksInfo.Range("A" & lRows(i) & ":" & "A" & lRows(i + 1) - 1)
            Call CalculateFill(rngPass)
        Next i
        '防止最后一个不同的数据项只有1行数据
        Set rngPass = wksInfo.Range("A" & lRows(UBound(lRows)) & ":" & "A" & lLastRow2)
        Call CalculateFill(rngPass)
    Else
        '没有不同的数据项
        Set rngPass = wksInfo.Range("A4:A" & lLastRow2)
        Call CalculateFill(rngPass)
    End If
 
    Set rngPass = Nothing
End Sub
 
 
Sub CalculateFill(rng)
    Dim lDays As Long, i As Long
    Dim lLastRow As Long, lLastRow1 As Long
    Dim MaxDay
 
    Application.ScreenUpdating = False
 
    lLastRow = wksCal.Range("A65536").End(xlUp).Row
    lLastRow1 = wksInfo.Range("A65536").End(xlUp).Row
 
    MaxDay = Application.WorksheetFunction.Max(wksInfo.Range("A4:A" & lLastRow1))
 
'    lDays = rng.Cells(rng.Rows.Count, 1) - rng.Cells(1, 1)
    lDays = MaxDay - rng.Cells(1, 1)
 
    wksCal.Range("A" & lLastRow + 1) = rng.Cells(1, 1)
 
    '填充日期
    For i = 1 To lDays
        wksCal.Range("A" & lLastRow + 1).Offset(i, 0) = rng.Cells(1, 1) + i
    Next i
 
 
    '计算存放吨数
    Dim rngFind As Range, rngFindRange As Range, rngFound As Range
    Dim varValue, j As Long
 
    '查找的区域
    Set rngFindRange = wksCal.Range("A" & lLastRow + 1 & ":" & "A" & lLastRow + lDays + 1)
 
    '查找存放的日期并计算值
    For Each rngFind In rng
        Set rngFound = rngFindRange.Find(rngFind)
        rngFound.Offset(0, 1) = rngFind.Offset(0, 1)
        rngFound.Offset(0, 2) = rngFound.Offset(0, 2) + rngFind.Offset(0, 2) - rngFind.Offset(0, 3)
        varValue = rngFound.Offset(0, 2).Value
        j = 0
        For i = rngFound.Row To lLastRow + lDays
            j = j + 1
            wksCal.Range("A" & rngFound.Row + j).Offset(0, 1) = rngFound.Offset(0, 1)
            wksCal.Range("A" & rngFound.Row + j).Offset(0, 2) = varValue
        Next i
    Next rngFind
 
    Application.ScreenUpdating = True
    '计算费用
    Call CalculateResult
End Sub
 
Sub CalculateResult()
    Dim lLastRow As Long
    lLastRow = wksCal.Range("A65536").End(xlUp).Row
    Application.ScreenUpdating = False
    wksCal.Range("D2:D" & lLastRow).FormulaR1C1 = "=VLookup(RC[-2],ProList,2,False)*RC[-1]"
    '转换公式为值
    wksCal.Range("D2:D" & lLastRow).Value = wksCal.Range("D2:D" & lLastRow).Value
    Application.ScreenUpdating = True
End Sub

示例文档下载：

相关文章

标签：
分类目录： Excel应用, VBA  |  评论  | 408 次阅读

Range对象应用大全(4)—Find方法应用大全

2009年08月16日, 8:21 下午
1 颗星2 颗星3 颗星4 颗星5 颗星 (4 人投票, 平均: 5.00 out of 5)
Loading ... Loading ...

本文整理了以前的一些关于Find方法的文章，作为Excel VBA应用大全的一部分。
1. Find方法的作用
使用VBA在工作表或单元格区域中查找某项数据时，我们通常使用For…Next循环，这在小范围中使用还可以，但应用在大量数据中查找时，会耗费较多时间。
而在Excel工作表中，通常使用菜单“编辑>>查找”命令或按Ctrl+F组合键，在“查找和替换”对话框中来迅速查找所需的数据。在VBA中，我们也能使用这种方法，即Find方法，这在下面的内容中介绍。
Find方法将在指定的单元格区域中查找包含参数指定数据的单元格，若找到符合条件的数据，则返回包含该数据的单元格；若未发现相匹配的数据，则返回Nothing。该方法返回一个Range对象，在使用该方法时，不影响选定区域或活动单元格。
为什么要使用Find方法呢？最主要的原因是查找的速度。如果要使用VBA代码在包含大量数据的单元格区域中查找某项数据，应该使用Find方法。
例如，在工作表Sheet1的单元格IV65536中输入fanjy，然后运行下面的代码：

Sub QuickSearch()
    If Not Sheet1.Cells.Find("fanjy") Is Nothing Then MsgBox "已找到fanjy!"
End Sub

再试试下面的代码：

Sub SlowSearch()
    Dim R As Range
    For Each R In Sheet1.Cells
        If R.Value = "fanjy" Then MsgBox "已找到fanjy!"
    Next R
End Sub

比较一下两段代码的速度，可知第一段代码运行很快，而第二段代码却要执行相当长的一段时间。
2. Find方法的语法
[语法]

<单元格区域>.Find (What，[After]，[LookIn]，[LookAt]，[SearchOrder]，[SearchDirection]，[MatchCase]，[MatchByte]，[SearchFormat])

[参数说明]
(1)<单元格区域>，必须指定，返回一个Range对象。
(2)参数What，必需指定。代表所要查找的数据，可以为字符串、整数或者其它任何数据类型的数据。对应于“查找与替换”对话框中，“查找内容”文本框中的内容。
(3)参数After，可选。指定开始查找的位置，即从该位置所在的单元格之后向后或之前向前开始查找(也就是说，开始时不查找该位置所在的单元格，直到Find方法绕回到该单元格时，才对其内容进行查找)。所指定的位置必须是单元格区域中的单个单元格，如果未指定本参数，则将从单元格区域的左上角的单元格之后开始进行查找。
(4)参数LookIn，可选。指定查找的范围类型，可以为以下常量之一：xlValues、xlFormulas或者xlComments，默认值为xlFormulas。对应于“查找与替换”对话框中，“查找范围”下拉框中的选项。
(5)参数LookAt，可选。可以为以下常量之一：XlWhole或者xlPart，用来指定所查找的数据是与单元格内容完全匹配还是部分匹配，默认值为xlPart。对应于“查找与替换”对话框中，“单元格匹配”复选框。
(6)参数SearchOrder，可选。用来确定如何在单元格区域中进行查找，是以行的方式(xlByRows)查找，还是以列的方式(xlByColumns)查找，默认值为xlByRows。对应于“查找与替换”对话框中，“搜索”下拉框中的选项。
(7)参数SearchDirection，可选。用来确定查找的方向，即是向前查找(XlPrevious)还是向后查找(xlNext)，默认的是向后查找。
(8)参数MatchCase，可选。若该参数值为True，则在查找时区分大小写。默认值为False。对应于“查找与替换”对话框中，“区分大小写”复选框。
(9)参数MatchByter，可选。即是否区分全角或半角，在选择或安装了双字节语言时使用。若该参数为True，则双字节字符仅与双字节字符相匹配；若该参数为False，则双字节字符可匹配与其相同的单字节字符。对应于“查找与替换”对话框中，“区分全角/半角”复选框。
(10)参数SearchFormat，可选，指定一个确切类型的查找格式。对应于“查找与替换”对话框中，“格式”按钮。当设置带有相应格式的查找时，该参数值为True。
(11)在每次使用Find方法后，参数LookIn、LookAt、SearchOrder、MatchByte的设置将保存。如果下次使用本方法时，不改变或指定这些参数的值，那么该方法将使用保存的值。
在VBA中设置的这些参数将更改“查找与替换”对话框中的设置；同理，更改“查找与替换”对话框中的设置，也将同时更改已保存的值。也就是说，在编写好一段代码后，若在代码中未指定上述参数，可能在初期运行时能满足要求，但若用户在“查找与替换”对话框中更改了这些参数，它们将同时反映到程序代码中，当再次运行代码时，运行结果可能会产生差异或错误。若要避免这个问题，在每次使用时建议明确的设置这些参数。
3. Find方法使用示例
3.1 本示例在活动工作表中查找what变量所代表的值的单元格，并删除该单元格所在的列。

Sub Find_Error()
  Dim rng As Range
  Dim what As String
  what = "Error"
  Do
    Set rng = ActiveSheet.UsedRange.Find(what)
    If rng Is Nothing Then
      Exit Do
    Else
       Columns(rng.Column).Delete
    End If
  Loop
End Sub

3.2 带格式的查找
本示例在当前工作表单元格中查找字体为”Arial Unicode MS”且颜色为红色的单元格。其中，Application.FindFormat对象允许指定所需要查找的格式，此时Find方法的参数SearchFormat应设置为True。

Sub FindWithFormat()
  With Application.FindFormat.Font
        .Name = "Arial Unicode MS"
        .ColorIndex = 3
  End With
  Cells.Find(what:="", SearchFormat:=True).Activate
End Sub

[小结] 在使用Find方法找到符合条件的数据后，就可以对其进行相应的操作了。您可以：

  • 对该数据所在的单元格进行操作；
  • 对该数据所在单元格的行或列进行操作；
  • 对该数据所在的单元格区域进行操作。

4. 与Find方法相联系的方法
可以使用FindNext方法和FindPrevious方法进行重复查找。在使用这两个方法之前，必须用Find方法指定所需要查找的数据内容。
4.1 FindNext方法
FindNext方法对应于“查找与替换”对话框中的“查找下一个”按钮。可以使用该方法继续执行查找，查找下一个与Find方法中所指定条件的数据相匹配的单元格，返回代表该单元格的Range对象。在使用该方法时，不影响选定区域或活动单元格。
4.1.1 语法

<单元格区域>.FindNext(After)

4.1.2 参数说明
参数After，可选。代表所指定的单元格，将从该单元格之后开始进行查找。开始时不查找该位置所在的单元格，直到FindNext方法绕回到该单元格时，才对其内容进行查找。所指定的位置必须是单元格区域中的单个单元格，如果未指定本参数，则将从单元格区域的左上角的单元格之后开始进行查找。
当查找到指定查找区域的末尾时，本方法将环绕至区域的开始继续查找。发生环绕后，为停止查找，可保存第一次找到的单元格地址，然后测试下一个查找到的单元格地址是否与其相同，作为判断查找退出的条件，以避免出现死循环。当然，如果在查找的过程中，将查找到的单元格数据进行了改变，也可不作此判断，如下例所示。
4.2 FindPrevious方法
可以使用该方法继续执行Find方法所进行的查找，查找前一个与Find方法中所指定条件的数据相匹配的单元格，返回代表该单元格的Range对象。在使用该方法时，不影响选定区域或活动单元格。
4.2.1 语法

<单元格区域>.FindPrevious(After)

4.2.2 参数说明
参数After，可选。代表所指定的单元格，将从该单元格之前开始进行查找。开始时不查找该位置所在的单元格，直到FindPrevious方法绕回到该单元格时，才对其内容进行查找。所指定的位置必须是单元格区域中的单个单元格，如果未指定本参数，则将从单元格区域的左上角的单元格之前开始进行查找。
当查找到指定查找区域的起始位置时，本方法将环绕至区域的末尾继续查找。发生环绕后，为停止查找，可保存第一次找到的单元格地址，然后测试下一个查找到的单元格地址是否与其相同，作为判断查找退出的条件，以避免出现死循环。
4.2.3 示例
在工作表中输入如下图1所示的数据，至少保证在A列中有两个单元格输入了数据“excelhome”。
find1 图1：测试的数据
在VBE编辑器中输入下面的代码测试Find方法、FindNext方法、FindPrevious方法，体验各个方法所查找到的单元格位置。

Sub testFind()
  Dim findValue As Range
  Set findValue = Worksheets("Sheet1").Columns("A").Find(what:="excelhome")
  MsgBox "第一个数据发现在单元格:" & findValue.Address
  Set findValue = Worksheets("Sheet1").Columns("A").FindNext(After:=findValue)
  MsgBox "下一个数据发现在单元格:" & findValue.Address
  Set findValue = Worksheets("Sheet1").Columns("A").FindPrevious(After:=findValue)
  MsgBox "前一个数据发现在单元格" & findValue.Address
End Sub

5. 综合示例
[示例1]查找值并选中该值所在的单元格
[示例1-1]

Sub Find_First()
    Dim FindString As String
    Dim rng As Range
    FindString = InputBox("请输入要查找的值:")
    If Trim(FindString) <> "" Then
        With Sheets("Sheet1").Range("A:A")
            Set rng = .Find(What:=FindString, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not rng Is Nothing Then
                Application.Goto rng, True
            Else
                MsgBox "没有找到!"
            End If
        End With
    End If
End Sub

示例说明：运行程序后，将在工作表Sheet1的A列中查找InputBox函数输入框中所输入的值，并查找该值所在的第一个单元格，如果没有找到该值，则显示消息框“没有找到!”。语句Application.Goto rng, True的作用是将窗口滚动至该单元格，即该单元格位于当前窗口的左上方。
[示例1-2]

Sub Find_Last()
    Dim FindString As String
    Dim rng As Range
    FindString = InputBox("请输入要查找的值")
    If Trim(FindString) <> "" Then
        With Sheets("Sheet1").Range("A:A")
            Set rng = .Find(What:=FindString, _
                            After:=.Cells(1), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False)
            If Not rng Is Nothing Then
                Application.Goto rng, True
            Else
                MsgBox "Nothing found"
            End If
        End With
  End If
End Sub

示例说明：与上面的程序不同的是，运行该程序后，将在工作表Sheet1的A列中查找InputBox函数输入框中所输入的值，并选中该值所在的最后一个单元格。请比较代码中Find方法的参数。
[示例1-3]

Sub Find_Todays_Date()
    Dim FindString As Date
    Dim rng As Range
    FindString = Date
    With Sheets("Sheet1").Range("A:A")
        Set rng = .Find(What:=FindString, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlFormulas, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
        If Not rng Is Nothing Then
            Application.Goto rng, True
        Else
            MsgBox "没有找到!"
        End If
    End With
End Sub

示例说明：运行程序后，将在工作表Sheet1的A列中查找日期所在的单元格，并选中第一个日期单元格。
[示例2]在B列中标出A列中有相应值的单元格

Sub Mark_cells_in_column()
    Dim FirstAddress As String
    Dim myArr As Variant
    Dim rng As Range
    Dim I As Long
 
    Application.ScreenUpdating = False
    myArr = Array("VBA")
    '也能够在数组中使用更多的值,如下所示
    'myArr = Array("VBA", "VSTO")
    With Sheets("Sheet2").Range("A:A")
 
        .Offset(0, 1).ClearContents
        '清除右侧单元格中的内容
 
        For I = LBound(myArr) To UBound(myArr)
            Set rng = .Find(What:=myArr(I), _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlFormulas, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            '如要想查找rng.value中的一部分,可使用参数值xlPart
            '如果使用LookIn:=xlValues,也会处理公式单元格中与条件相同的值
 
            If Not rng Is Nothing Then
                FirstAddress = rng.Address
                Do
                    rng.Offset(0, 1).Value = "X"
                    '如果值VBA找到,则在该单元格的右侧列中的相应单元格作上标记
                    Set rng = .FindNext(rng)
                Loop While Not rng Is Nothing And rng.Address <> FirstAddress
            End If
        Next I
    End With
    Application.ScreenUpdating = True
End Sub

示例说明：运行程序后，将查找工作表Sheet2上A列中的每个单元格，并在值为“VBA”所在的单元格的右侧单元格中作出标记“X”。
[示例3]为区域中指定值的单元格填充颜色

Sub Color_cells_in_Range()
    Dim FirstAddress As String
    Dim MySearch As Variant
    Dim myColor As Variant
    Dim rng As Range
    Dim I As Long
 
    MySearch = Array("VBA")
    myColor = Array("3")
 
    '也能在数组中使用多个值
    'MySearch = Array("VBA", "Hello", "OK")
    'myColor = Array("3", "6", "10")
 
    With Sheets("Sheet3").Range("A1:C4")
 
        '将所有单元格中的填充色改为无填充色
        .Interior.ColorIndex = xlColorIndexNone
 
         For I = LBound(MySearch) To UBound(MySearch)
            Set rng = .Find(What:=MySearch(I), _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlFormulas, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            '如果想查找rng.value的一部分,则使用参数值xlPart
            '如果使用LookIn:=xlValues,则也会处理公式单元格
 
            If Not rng Is Nothing Then
                FirstAddress = rng.Address
                Do
                    rng.Interior.ColorIndex = myColor(I)
                    Set rng = .FindNext(rng)
                Loop While Not rng Is Nothing And rng.Address <> FirstAddress
            End If
        Next I
    End With
End Sub

示例说明：运行程序后，将在工作表Sheet3上的单元格区域A1：C4中查找含有“VBA”的单元格，并将这些单元格填充为红色。如示例中的注释所提示的，也可以使用数组，将不同的值所在的单元格标记为不同的颜色。
也可以添加下面的语句，改变单元格中文本的颜色：

.Font.ColorIndex=0
.Font.ColorIndex=myColor(I)

[示例4]为工作表中指定值的单元格填充颜色

Sub Color_cells_in_Sheet()
    Dim FirstAddress As String
    Dim MySearch As Variant
    Dim myColor As Variant
    Dim rng As Range
    Dim I As Long
 
    MySearch = Array("VBA")
    myColor = Array("3")
 
    '也能在数组中使用多个值
    'MySearch = Array("VBA", "Hello", "OK")
    'myColor = Array("3", "6", "10")
 
    With Sheets("Sheet4").Cells
 
        '将所有单元格中的填充色改为无填充色
        .Interior.ColorIndex = xlColorIndexNone
 
        For I = LBound(MySearch) To UBound(MySearch)
            Set rng = .Find(What:=MySearch(I), _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlFormulas, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
           '如果想查找rng.value的一部分,则使用参数值xlPart
           '如果使用LookIn:=xlValues,则也会处理公式单元格
 
            If Not rng Is Nothing Then
                FirstAddress = rng.Address
                Do
                    rng.Interior.ColorIndex = myColor(I)
                    Set rng = .FindNext(rng)
                Loop While Not rng Is Nothing And rng.Address <> FirstAddress
            End If
        Next I
    End With
End Sub

示例说明：运行程序后，将在工作表Sheet4中查找含有“VBA”的单元格，并将这些单元格填充为红色。如示例中的注释所提示的，也可以使用数组，将不同的值所在的单元格标记为不同的颜色。
也可以添加下面的语句，改变单元格中文本的颜色：

.Font.ColorIndex=0
.Font.ColorIndex=myColor(I)

[示例5]为工作簿所有工作表中含有指定值的单元格填充颜色

Sub Color_cells_in_All_Sheets()
    Dim FirstAddress As String
    Dim MySearch As Variant
    Dim myColor As Variant
    Dim sh As Worksheet
    Dim rng As Range
    Dim I As Long
 
    MySearch = Array("ron")
    myColor = Array("3")
 
   '也能在数组中使用多个值
    'MySearch = Array("VBA", "Hello", "OK")
    'myColor = Array("3", "6", "10")
 
    For Each sh In ActiveWorkbook.Worksheets
        With sh.Cells
 
             '将所有单元格中的填充色改为无填充色
            .Interior.ColorIndex = xlColorIndexNone
 
            For I = LBound(MySearch) To UBound(MySearch)
                Set rng = .Find(What:=MySearch(I), _
                                After:=.Cells(.Cells.Count), _
                                LookIn:=xlFormulas, _
                                LookAt:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=False)
                '如果想查找rng.value的一部分,则使用参数值xlPart
                '如果使用LookIn:=xlValues,则也会处理公式单元格
 
                If Not rng Is Nothing Then
                    FirstAddress = rng.Address
                    Do
                        rng.Interior.ColorIndex = myColor(I)
                        Set rng = .FindNext(rng)
                    Loop While Not rng Is Nothing And rng.Address <> FirstAddress
                End If
            Next I
        End With
    Next sh
End Sub

示例说明：运行程序后，将在工作簿所有工作表中查找含有“VBA”的单元格，并将这些单元格填充为红色。如示例中的注释所提示的，也可以使用数组，将不同的值所在的单元格标记为不同的颜色。
也可以添加下面的语句，改变单元格中文本的颜色：

.Font.ColorIndex=0
.Font.ColorIndex=myColor(I)

[示例6]复制相应的值到另一个工作表中

Sub Copy_To_Another_Sheet()
    Dim FirstAddress As String
    Dim MyArr As Variant
    Dim Rng As Range
    Dim Rcount As Long
    Dim I As Long
 
    Application.ScreenUpdating = False
    '也能够使用含有更多值的数组
    'myArr = Array("@", "www")
    MyArr = Array("@")
 
    Rcount = 0
    With Sheets("Sheet5").Range("A1:E10")
 
        For I = LBound(MyArr) To UBound(MyArr)
            '如果使用LookIn:=xlValues,也会处理含有"@"的公式单元格
            '注意:本示例使用xlPart而不是xlWhole

            Set Rng = .Find(What:=MyArr(I), _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlFormulas, _
                            LookAt:=xlPart, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not Rng Is Nothing Then
                FirstAddress = Rng.Address
                Do
                    Rcount = Rcount + 1
                    '仅复制值
                    Sheets("Sheet6").Range("A" & Rcount).Value = Rng.Value
                    Set Rng = .FindNext(Rng)
                Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress
            End If
        Next I
    End With
End Sub

示例说明：运行程序后，将在工作表Sheet5的单元格区域A1:E10中查找带有“@”的单元格，即e-mail地址，然后将这些单元格值依次复制到工作表Sheet6的A列中。注意，本例中使用参数值为xlPart，并且仅复制单元格值，即不带格式。
[示例7]在当前工作表的单元格区域A1:A50中输入数据5和其它的一些数据，然后在VBE编辑器中输入下面的代码。运行后，程序将在单元格A1:A50区域中查找数值5所在的单元格，并在所找到的单元格中画一个蓝色的椭圆。

Sub FindSample1()
  Dim Cell As Range, FirstAddress As String
  With Worksheets(1).Range("A1:A50")
    Set Cell = .Find(5)
    If Not Cell Is Nothing Then
       FirstAddress = Cell.Address
       Do
         With Worksheets(1).Ovals.Add(Cell.Left, _
                                      Cell.Top, Cell.Width, _
                                      Cell.Height)
                                 .Interior.Pattern = xlNone
                                 .Border.ColorIndex = 5
         End With
         Set Cell = .FindNext(Cell)
         Loop Until Cell Is Nothing Or Cell.Address = FirstAddress
    End If
  End With
End Sub

[示例8]在一个列表中复制相关数据到另一个列表
本程序的功能是，根据单元格I1中的值，在单元格区域A1:D11中的B列进行查找，每次找到相应的值，就将该单元格所在区域的行数据复制到以单元格G3(该单元格命名为found)开始的区域中。原数据如下图2所示。
find2
图2：原始数据
点击工作表中的“查找”按钮，运行后的结果如下图3所示。
find3
图3：运行后的结果
源程序代码清单及相关说明如下：

Option Explicit
Sub FindSample2()
  Dim ws As Worksheet
  Dim rgSearchIn As Range
  Dim rgFound As Range
  Dim sFirstFound As String
  Dim bContinue As Boolean
 
  ReSetFoundList '初始化要复制的列表区域
  Set ws = ThisWorkbook.Worksheets("sheet1")
  bContinue = True
  Set rgSearchIn = GetSearchRange(ws) '获取查找区域
  
  '设置查找参数
  Set rgFound = rgSearchIn.Find(what:=ws.Range("I1").Value, _
             LookIn:=xlValues, LookAt:=xlWhole)
 
  '获取第一个满足条件的单元格地址,作为结束循环的条件
  If Not rgFound Is Nothing Then sFirstFound = rgFound.Address
 
  Do Until rgFound Is Nothing Or Not bContinue
    CopyItem rgFound
    Set rgFound = rgSearchIn.FindNext(rgFound)
    '判断循环是否中止
    If rgFound.Address = sFirstFound Then bContinue = False
  Loop
 
  Set rgSearchIn = Nothing
  Set rgFound = Nothing
  Set ws = Nothing
End Sub
 
'获取查找区域,即B列中的"部位"单元格区域
Private Function GetSearchRange(ws As Worksheet) As Range
  Dim lLastRow As Long
  lLastRow = ws.Cells(65536, 1).End(xlUp).Row
  Set GetSearchRange = ws.Range(ws.Cells(1, 2), ws.Cells(lLastRow, 2))
End Function
 
'复制查找到的数据到found区域
Private Sub CopyItem(rgItem As Range)
  Dim rgDestination As Range
  Dim rgEntireItem As Range
 
  '获取在查找区域中的整行数据
  Set rgEntireItem = rgItem.Offset(0, -1)
  Set rgEntireItem = rgEntireItem.Resize(1, 4)
 
  Set rgDestination = rgItem.Parent.Range("found")
  '定位要复制到的found区域的第一行
  If IsEmpty(rgDestination.Offset(1, 0)) Then
    Set rgDestination = rgDestination.Offset(1, 0)
  Else
    Set rgDestination = rgDestination.End(xlDown).Offset(1, 0)
  End If
 
  '复制找到的数据到found区域
  rgEntireItem.Copy rgDestination
 
  Set rgDestination = Nothing
  Set rgEntireItem = Nothing
End Sub
 
'初始化要复制到的区域(found区域)
Private Sub ReSetFoundList()
  Dim ws As Worksheet
  Dim lLastRow As Long
  Dim rgTopLeft As Range
  Dim rgBottomRight As Range
 
  Set ws = ThisWorkbook.Worksheets("sheet1")
  Set rgTopLeft = ws.Range("found").Offset(1, 0)
  lLastRow = ws.Range("found").End(xlDown).Row
  Set rgBottomRight = ws.Cells(lLastRow, rgTopLeft.Offset(0, 3).Column)
 
  ws.Range(rgTopLeft, rgBottomRight).ClearContents
 
  Set rgTopLeft = Nothing
  Set rgBottomRight = Nothing
  Set ws = Nothing
End Sub

在上述程序代码中，程序FindSample2( )为主程序，首先调用子程序ReSetFoundList( )对所要复制到的数据区域初始化，即清空除标题行以外的内容；然后调用自定义函数GetSearchRange(ws As Worksheet)获取所在查找的单元格区域；在主程序中使用Find方法和FIndNext方法进行查找，调用带参数的子程序CopyItem(rgItem As Range)将查找到的单元格所在的数据行复制到相应的区域。
[示例9]实现带连续单元格区域条件的查找
下面的代码提供了一种实现以连续单元格区域中的数据为查找条件进行查找的方法和思路。在本例中，所查找条件区域为D2:D4，在单元格区域A1:A21中进行查找，将结果输入到以单元格F2开始的区域中。示例程序所对应的工作表数据及结果如下图4所示。

Sub FindGroup()
  Dim ToFind As Range, Found As Range, c As Range
  Dim FirstAddress As String
  Set ToFind = Range("D2:D4")
  With Worksheets(1).Range("a1:a21")
    Set c = .Find(ToFind(1), LookIn:=xlValues)
    If Not c Is Nothing Then
      FirstAddress = c.Address
      Do
        If c.Offset(1) = ToFind(2) And c.Offset(2) = ToFind(3) Then
          Set Found = Range(c.Offset(0, 1), c.Offset(0, 1).Offset(2))
          GoTo Exits
        End If
        Set c = .FindNext(c)
      Loop While Not c Is Nothing And c.Address <> FirstAddress
    End If
  End With
Exits:
  Found.Copy Range("F2")
End Sub

find4 图4：数据及查找结果
[示例10]本示例所列程序将在工作簿的所有工作表中查找数值，提供了采用两种方法编写的程序，一种是Find方法，另一种是SpecialCells 方法。相对来说，使用Find方法比使用SpecialCells方法要快，当然，本示例可能不明显，但对于带大量工作表和数据的工作簿来说，这种速度差异就可以看出来了。
示例代码如下，代码中有简要的说明。

'- - -使用Find方法 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Sub QuickSearch()
  Dim wks As Excel.Worksheet
  Dim rCell As Excel.Range
  Dim szFirst As String
  Dim i As Long
  '设置变量决定是否加亮显示查找到的单元格
  '该变量为真时则加亮显示
  Dim bTag As Boolean
  bTag = True
  '使用input接受查找条件的输入
  Dim szLookupVal As String
  szLookupVal = InputBox("在下面的文本框中输入您想要查找的值", "查找输入框", "")
 
  '如果没有输入任何数据,则退出程序
  If szLookupVal = "" Then Exit Sub
 
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
 
  ' =============================================================
  ' 添加一个工作表,在该工作表中放置已查找到的单元格地址
  ' 如果该工作表存在,则先删除它
    For Each wks In ActiveWorkbook.Worksheets
      If wks.Name = "查找结果" Then
        wks.Delete
      End If
    Next wks
 
  ' 添加工作表
    Sheets.Add ActiveSheet
  ' 重命名所添加的工作表
    ActiveSheet.Name = "查找结果"
  ' 在新增工作表中添加标题,指明所查找的值
    With Cells(1, 1)
      .Value = "已在下面所列出的位置找到数值" & szLookupVal
      .EntireColumn.AutoFit
      .HorizontalAlignment = xlCenter
    End With
 
  ' =============================================================
  ' 定位到刚开始的工作表
    ActiveSheet.Next.Select
 
  ' =============================================================
  ' 提示您是否想高亮显示已查找到的单元格
    If MsgBox("您想加阴影高亮显示所有查找到的单元格吗?", vbYesNo, _
              "加阴影高亮显示单元格") = vbNo Then
    ' 如果不想加阴影显示单元格,则将变量bTag值设置为False
      bTag = False
    End If
 
  ' =============================================================
    i = 2
  ' 开始在工作簿的所有工作表中搜索
    For Each wks In ActiveWorkbook.Worksheets
  ' 检查所有的单元格,Find方法比SpecialCells方法更快
      With wks.Cells
        Set rCell = .Find(szLookupVal, , , xlWhole, xlByColumns, xlNext, False)
        If Not rCell Is Nothing Then
          szFirst = rCell.Address
          Do
           ' 添加找到的单元格地址到新工作表中
            rCell.Hyperlinks.Add Sheets("查找结果").Cells(i, 1), "", "'" & wks.Name & "'!" & rCell.Address
           '  检查条件判断值bTag,以决定是否加亮显示单元格
             Select Case bTag
                    Case True
                       rCell.Interior.ColorIndex = 19
             End Select
             Set rCell = .FindNext(rCell)
             i = i + 1
          Loop While Not rCell Is Nothing And rCell.Address <> szFirst
        End If
      End With
    Next wks
 
  ' 释放内存变量
    Set rCell = Nothing
 
  ' 如果没有找到匹配的值,则移除新增工作表
    If i = 2 Then
      MsgBox "您所要查找的数值{" & szLookupVal & "}在这些工作表中没有发现", 64, "没有匹配值"
      Sheets("查找结果").Delete
    End If
 
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
 
'- - - 使用SpecialCells 方法- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Option Compare Text
Sub SlowerSearch()
    Dim wks As Excel.Worksheet
    Dim rCell As Excel.Range
    Dim i As Long
  '设置变量决定是否加亮显示查找到的单元格
  '该变量为真时则加亮显示
    Dim bTag As Boolean
    bTag = True
  '使用input接受查找条件的输入
    Dim szLookupVal As String
    szLookupVal = InputBox("在下面的文本框中输入您想要查找的值", "查找输入框", "")
 
  '如果没有输入任何数据,则退出程序
    If szLookupVal = "" Then Exit Sub
    With Application
      .ScreenUpdating = False
      .DisplayAlerts = False
      .Calculation = xlCalculationManual
 
  ' =============================================================
  ' 添加一个工作表,在该工作表中放置已查找到的单元格地址
  ' 如果该工作表存在,则先删除它
    For Each wks In ActiveWorkbook.Worksheets
      If wks.Name = "查找结果" Then
        wks.Delete
      End If
    Next wks
 
  ' 添加工作表
    Sheets.Add ActiveSheet
  ' 重命名所添加的工作表
    ActiveSheet.Name = "查找结果"
  ' 在新增工作表中添加标题,指明所查找的值
    With Cells(1, 1)
      .Value = "已在下面所列出的位置找到数值" & szLookupVal
      .EntireColumn.AutoFit
      .HorizontalAlignment = xlCenter
    End With
 
  ' =============================================================
  ' 定位到刚开始的工作表
    ActiveSheet.Next.Select
 
  ' =============================================================
    ' 提示您是否想高亮显示已查找到的单元格
    If MsgBox("您想加阴影高亮显示所有查找到的单元格吗?", vbYesNo, _
              "加阴影高亮显示单元格") = vbNo Then
    ' 如果不想加阴影显示单元格,则将变量bTag值设置为False
      bTag = False
    End If
 
  ' =============================================================
   i = 2
  ' 开始在工作簿的所有工作表中搜索
    On Error Resume Next
    For Each wks In ActiveWorkbook.Worksheets
      If wks.Cells.SpecialCells(xlCellTypeConstants).Count = 0 Then GoTo NoSpecCells
        For Each rCell In wks.Cells.SpecialCells(xlCellTypeConstants)
          DoEvents
          If rCell.Value = szLookupVal Then
           ' 添加找到的单元格地址到新工作表中
             rCell.Hyperlinks.Add Sheets("查找结果").Cells(i, 1), "", "'" & wks.Name & "'!" & rCell.Address
           '  检查条件判断值bTag,以决定是否加亮显示单元格
             Select Case bTag
                    Case True
                      rCell.Interior.ColorIndex = 19
             End Select
             i = i + 1
             .StatusBar = "查找到的单元格数为: " & i - 2
          End If
       Next rCell
NoSpecCells:
    Next wks
 
  ' 如果没有找到匹配的值,则移除新增工作表
  If i = 2 Then
    MsgBox "您所要查找的数值{" & szLookupVal & "}在这些工作表中没有发现", 64, "没有匹配值"
    Sheets("查找结果").Delete
  End If
 
  .Calculation = xlCalculationAutomatic
  .DisplayAlerts = True
  .ScreenUpdating = True
  .StatusBar = Empty
  End With
End Sub

6. 其它一些查找方法
可以使用For Each … Next语句和Like运算符进行更精确匹配的查找。例如，下列代码在单元格区域A1:A10中查找以字符“我”开头的单元格，并将其背景色变为红色。

Sub test()
  Dim Cell As Range
  For Each Cell In [A1:A10]
    If Cell Like "我*" Then
        Cell.Interior.ColorIndex = 3
    End If
  Next
End Sub

可以输入如下图5所示的数据进行测试。
find5
7. 扩展Find方法
我们能够使用Find方法查找单元格区域的数据，但是没有一个方法能够返回一个Range对象，该对象引用了含有所查找数据的所有单元格，下面提供了一个FindAll函数来实现此功能。此外，Find方法的另一个不足之处是不支持通配符字符串，下面也提供了一个WildCardMatchCells函数，返回一个Range对象，引用了与所提供的通配符字符串相匹配的单元格。通配符字符串可以是有效使用在Like运算符中的任何字符串。
7.1 FindAll函数
这个程序在参数SearchRange所代表的区域中查找所有含有参数FindWhat代表的值的单元格，SearchRange参数必须是一个单独的单元格区域对象，FindWhat参数是想要查找的值，其它参数是可选的且与Find方法的参数意思相同。
FindAll函数的代码如下：

Option Compare Text
Function FindAll(SearchRange As Range, FindWhat As Variant, _
    Optional LookIn As XlFindLookIn = xlValues, Optional LookAt As XlLookAt = xlWhole, _
    Optional SearchOrder As XlSearchOrder = xlByRows, _
    Optional MatchCase As Boolean = False) As Range
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 返回SearchRange区域中含有FindWhat所代表的值的所有单元格组成的Range对象
' 其参数与Find方法的参数相同
' 如果没有找到单元格,将返回Nothing.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  Dim FoundCell As Range
  Dim FoundCells As Range
  Dim LastCell As Range
  Dim FirstAddr As String
  With SearchRange
    Set LastCell = .Cells(.Cells.Count)
  End With
  Set FoundCell = SearchRange.Find(what:=FindWhat, after:=LastCell, _
    LookIn:=LookIn, LookAt:=LookAt, SearchOrder:=SearchOrder, MatchCase:=MatchCase)
  If Not FoundCell Is Nothing Then
    Set FoundCells = FoundCell
    FirstAddr = FoundCell.Address
    Do
      Set FoundCells = Application.Union(FoundCells, FoundCell)
      Set FoundCell = SearchRange.FindNext(after:=FoundCell)
    Loop Until (FoundCell Is Nothing) Or (FoundCell.Address = FirstAddr)
  End If
 
  If FoundCells Is Nothing Then
    Set FindAll = Nothing
  Else
    Set FindAll = FoundCells
  End If
End Function
使用上面代码的示例：
Sub TestFindAll()
    Dim SearchRange As Range
    Dim FoundCells As Range
    Dim FoundCell As Range
    Dim FindWhat As Variant
    Dim MatchCase As Boolean
    Dim LookIn As XlFindLookIn
    Dim LookAt As XlLookAt
    Dim SearchOrder As XlSearchOrder
 
    Set SearchRange = ThisWorkbook.Worksheets(1).Range("A1:L20")
    FindWhat = "A" '要查找的文本,可根据实际情况自定
    LookIn = xlValues
    LookAt = xlPart
    SearchOrder = xlByRows
    MatchCase = False
 
    Set FoundCells = FindAll(SearchRange:=SearchRange, FindWhat:=FindWhat, _
        LookIn:=LookIn, LookAt:=LookAt, SearchOrder:=SearchOrder, MatchCase:=MatchCase)
 
    If FoundCells Is Nothing Then
        Debug.Print "没有找到!"
    Else
        For Each FoundCell In FoundCells.Cells
            Debug.Print FoundCell.Address, FoundCell.Text
        Next FoundCell
    End If
 
End Sub

上面的代码中，列出了查找区域中含有所要查找的数据的所有单元格的地址以及相应文本。不仅可以找出所有含有所查找数据的单元格地址，而且也可以对这些单元格进行一系列操作，如格式化、更改数据等。
7.2 WildCardMatchCells函数
这个程序查找参数SearchRange所代表的区域中所有单元格，使用Like运算符将它们的值与参数CompareLikeString所代表的值比较。参数SearchRange必须是一个单独的区域，参数CompareLikeString是想要比较的文本的格式。该函数使用单元格的Text属性而不是Value属性。可选参数SearchOrder和MatchCase与Find方法中的参数意义相同。
该函数返回一个Range对象，该对象包含对与参数CompareLikeString相匹配的所有单元格的引用。如果没有匹配的单元格，则返回Nothing。
因为Find方法不支持通配符，程序将循环所有的单元格，因此对于包含大量数据的区域，执行时间可能是一个问题。并且，如果参数MatchCase为False或忽略该参数，文本在程序中必须被转换成大写，以便于查找时不区分大小写(即“A”=“a”)，因此，此时程序运行将更慢。
WildCardMatchCells函数的代码如下：

Function WildCardMatchCells(SearchRange As Range, CompareLikeString As String, _
    Optional SearchOrder As XlSearchOrder = xlByRows, _
    Optional MatchCase As Boolean = False) As Range
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 本程序返回文本值与通配符字符串相匹配的单元格引用
' 返回SearchRange区域中所有相匹配的单元格
' 匹配的条件是参数CompareLikeString
' 使用了VBA中的LIKE运算符
' 如果没有相匹配的单元格或指定了一个无效的参数,则返回Nothing.
'
' 参数SearchOrder指定查找的方向;逐行还是逐列(SearchOrder:=xlByRows或SearchOrder:=xlByColumns
' 参数MatchCase指定是否区分大小写(MatchCase:=True, "A" <> "a")或(MatchCase:=False,"A" = "a").
'
' 不需要在模块顶指定"Option Compare Text",如果指定的话,将不会正确执行大小写比较
'
' 执行单元格中的Text属性比较,而不是Value属性比较
' 因此,仅比较显示在屏幕中的文本,而不是隐藏在单元格中具体的值
'
' 如果参数SearchRange是nothing或多个区域,则返回Nothing.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  Dim FoundCells As Range
  Dim FirstCell As Range
  Dim LastCell As Range
  Dim RowNdx As Long
  Dim ColNdx As Long
  Dim StartRow As Long
  Dim EndRow As Long
  Dim StartCol As Long
  Dim EndCol As Long
  Dim WS As Worksheet
  Dim Rng As Range
 
' 确保参数SearchRange不是Nothing且是一个单独的区域
  If SearchRange Is Nothing Then
    Exit Function
  End If
  If SearchRange.Areas.Count > 1 Then
    Exit Function
  End If
 
  With SearchRange
    Set WS = .Worksheet
    Set FirstCell = .Cells(1)
    Set LastCell = .Cells(.Cells.Count)
  End With
 
  StartRow = FirstCell.Row
  StartCol = FirstCell.Column
  EndRow = LastCell.Row
  EndCol = LastCell.Column
 
  If SearchOrder = xlByRows Then
    With WS
      For RowNdx = StartRow To EndRow
        For ColNdx = StartCol To EndCol
          Set Rng = .Cells(RowNdx, ColNdx)
            If MatchCase = False Then
             '''''''''''''''''''''''''''''''''''
             '如果参数MatchCase是False,则将字符串转换成大写
             '执行忽略大小写的比较
             '因此,MatchCase:=False比MatchCase:=True更慢
             '''''''''''''''''''''''''''''''''''
               If UCase(Rng.Text) Like UCase(CompareLikeString) Then
                 If FoundCells Is Nothing Then
                    Set FoundCells = Rng
                 Else
                    Set FoundCells = Application.Union(FoundCells, Rng)
                 End If
               End If
              Else
                ''''''''''''''''''''''''''''''''''''''''''''''''
                ' MatchCase为真,不需要再进行大小写转换,因此更快些
                ' 这也是不需要在模块中指定"Option Compare Text"的原因
                ''''''''''''''''''''''''''''''''''''''''''''''''
                If Rng.Text Like CompareLikeString Then
                  If FoundCells Is Nothing Then
                    Set FoundCells = Rng
                  Else
                    Set FoundCells = Application.Union(FoundCells, Rng)
                  End If
                End If
            End If
        Next ColNdx
      Next RowNdx
    End With
  Else
    With WS
      For ColNdx = StartCol To EndCol
        For RowNdx = StartRow To EndRow
          Set Rng = .Cells(RowNdx, ColNdx)
          If MatchCase = False Then
            If UCase(Rng.Text) Like UCase(CompareLikeString) Then
              If FoundCells Is Nothing Then
                Set FoundCells = Rng
              Else
                Set FoundCells = Application.Union(FoundCells, Rng)
              End If
            End If
          Else
            If Rng.Text Like CompareLikeString Then
              If FoundCells Is Nothing Then
                Set FoundCells = Rng
              Else
                Set FoundCells = Application.Union(FoundCells, Rng)
              End If
            End If
          End If
        Next RowNdx
      Next ColNdx
    End With
  End If
 
  If FoundCells Is Nothing Then
    Set WildCardMatchCells = Nothing
  Else
    Set WildCardMatchCells = FoundCells
  End If
End Function

使用上面代码的示例：

Sub TestWildCardMatchCells()
    Dim SearchRange As Range
    Dim FoundCells As Range
    Dim FoundCell As Range
    Dim CompareLikeString As String
    Dim SearchOrder As XlSearchOrder
    Dim MatchCase As Boolean
 
    Set SearchRange = Range("A1:IV65000")
    CompareLikeString = "A?C*"
    SearchOrder = xlByRows
    MatchCase = True
 
    Set FoundCells = WildCardMatchCells(SearchRange:=SearchRange, CompareLikeString:=CompareLikeString, _
        SearchOrder:=SearchOrder, MatchCase:=MatchCase)
    If FoundCells Is Nothing Then
        Debug.Print "没有找到!"
    Else
        For Each FoundCell In FoundCells
          Debug.Print FoundCell.Address, FoundCell.Text
        Next FoundCell
    End If
End Sub

这样，在找到所需单元格后，就可以对这些单元格进行操作了。

相关文章

标签：, , ,
分类目录： VBA  |  1 评论  | 1,454 次阅读

Range对象应用大全(3)—CurrentRegion属性详解

2009年07月23日, 2:22 下午
1 颗星2 颗星3 颗星4 颗星5 颗星 (2 人投票, 平均: 4.50 out of 5)
Loading ... Loading ...

本文为以前编写的一篇文章，转贴于此，作为Excel VBA应用大全的一部分。
CurrentRegion属性代表什么
您可能经常在程序代码中看到CurrentRegion属性，它是一个非常有用的属性，返回活动单元格所在的周围由空行和空列组成的单元格区域(即通常所说的当前区域)，如图1所示。

图1
具体地说，当前区域即活动单元格所在的矩形区域，该矩形区域的每一行和每一列中至少包含有一个数据，其周围是空行和空列，图1中列举了其中的4种情形（见蓝色阴影区域）。在当前区域范围内，不管活动单元格是哪一个单元格，其所在的当前区域均为同一区域，如上例中的B5:D7区域，活动单元格B5的当前区域为B5:D7，当活动单元格为C6时，其当前区域仍为B5:D7。
使用CurrentRegion属性相当于在Excel工作表中选择菜单“编辑——定位”命令，在弹出的“定位”对话框中单击“定位条件”按钮，然后在“定位条件”对话框中选中“当前区域”选项按钮，或者相当于使用Ctrl+Shift+*组合键。
CurrentRegion属性的一些基本应用
CurrentRegion属性可用于很多操作，下面通过如图2所示的工作表示例讲解该属性的应用。

图2
（1）返回指定（或活动）单元格所在区域中标题行的行数

Worksheets("sheet1").Range("H2").Value = _
Worksheets("sheet1").Range("A1").CurrentRegion.ListHeaderRows

上述代码在示例工作表中运行后，将返回“1”，即单元格A1所在区域的标题行的行数为1。
（2）返回指定（或活动）单元格所在区域的行数

Worksheets("sheet1").Range("H3").Value = _
Worksheets("sheet1").Range("A1").CurrentRegion.Rows.Count

上述代码在示例工作表中运行后，将返回“11”，即单元格A1所在区域的行数为11。
（3）返回指定（或活动）单元格所在区域的列数

Worksheets("sheet1").Range("H4").Value = _
Worksheets("sheet1").Range("A1").CurrentRegion.Columns.Count

上述代码在示例工作表中运行后，将返回“4”，即单元格A1所在区域的列数为4。
（4）返回指定（或活动）单元格所在区域的单元格数

Worksheets("sheet1").Range("H5").Value = _
Worksheets("sheet1").Range("A1").CurrentRegion.Cells.Count

上述代码在示例工作表中运行后，将返回“44”，即单元格A1所在区域的单元格数为44。
（5）在指定（或活动）单元格所在区域中选取除标题行以外的数据区域

Worksheets("sheet1").Range("A1").CurrentRegion.Resize( _
Worksheets("sheet1").Range("A1").CurrentRegion.Rows.Count - Worksheets("sheet1"). _
Range("A1").CurrentRegion.ListHeaderRows, Worksheets("sheet1").Range("A1").CurrentRegion. _
Columns.Count).Offset(1, 0).Select

上述代码在示例工作表中运行后，将选取单元格A1所在区域中除标题行外的数据区域，即单元格区域A2:D11。
下面，将上述代码综合成一个完整的示例以演示CurrentRegion属性的一些用法。程序代码如下：

Sub testCurrentRegion()
    Dim rng As Range, ws As Worksheet
    Set ws = ActiveWorkbook.Worksheets("sheet1")
    Set rng = ws.Range("A1").CurrentRegion
    ws.Range("G2") = "当前区域标题行数"
    ws.Range("H2").Value = rng.ListHeaderRows
    ws.Range("G3") = "当前区域的行数"
    ws.Range("H3").Value = rng.Rows.Count
    ws.Range("G4") = "当前区域的列数"
    ws.Range("H4").Value = rng.Columns.Count
    ws.Range("G5").Value = "当前区域的单元格数"
    ws.Range("H5").Value = rng.Cells.Count
    ws.Columns("G:G").EntireColumn.AutoFit
    MsgBox "选取当前区域中除标题行以外的区域"
    rng.Resize(rng.Rows.Count - rng.ListHeaderRows, rng.Columns.Count).Offset(1, 0).Select
End Sub

运行后的结果如下图3所示，示例文档见：


图3
（6）复制当前区域的数据到另一位置

Sub CopyCurrentRegion()
    Sheets("sheet1").Range("A1").CurrentRegion.Copy Sheets("sheet2").Range("A1")
End Sub

上述代码将工作表Sheet1中单元格A1所在的区域复制到工作表sheet2中以单元格A1开始的单元格区域中。
（7）格式化当前区域中的数据

Sub FormatCurrentRegion()
    With ActiveCell.CurrentRegion
        .Font.Bold = True
        .Font.ColorIndex = 3
    End With
End Sub

上述代码将工作表中活动单元格所在区域数据加粗且设置为红色。
（8）在当前区域中自动套用格式

Sub testAutoFormatCurrentRegion()
    Worksheets("sheet1").Range("A1").CurrentRegion.AutoFormat
End Sub

上述代码将在工作表sheet1中单元格A1所在区域自动套用默认的格式，当然，您可以设置所需套用的格式，默认值为xlRangeAutoFormatClassic1。
一些示例
[示例1]在当前区域中查找空白单元格并填充
如下图4所示的工作表，现在要使用空白单元格上方的有数据的单元格中的数据来填充空白单元格。

图4
可以编写如下的代码：

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所在区域中的空白单元格被相应数据填充，如图5所示。

图5
示例下载：

[示例2] 一个排序的简单示例
如图6所示的工作表，现在对第3列进行排序，按降序排列。

图6
编写的代码如下：

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列的数据从大到小进行排列，如图7所示。

图7
示例下载：

小结
1、CurrentRegion属性的基本语法为：
<单元格对象>.CurrentRegion
2、可以先使用CurrentRegion属性返回指定单元格或者活动单元格所在的区域，然后使用其它的属性对该区域的数据进行操作。

相关文章

标签：,
分类目录： VBA  |  评论  | 1,012 次阅读

Range对象应用大全(2)—找到工作表中的最后一行

2009年07月2日, 1:47 下午
1 颗星2 颗星3 颗星4 颗星5 颗星 (4 人投票, 平均: 3.75 out of 5)
Loading ... Loading ...

题注：这是在以前的博客中整理的一篇文章，收集到这里，作为Range对象应用大全的一部分。
在Excel中，如果想使用VBA在工作表的最后一行输入数据，则必须先找到最后一行的位置，而在有些情况下，已输入的数据中可能有隐藏的行，也可能最后一行的数据没有显示，也可能最后一行没有数据但存在格式。此时，该如何有效地找到最后一行呢？又如，如果想找到最后一个公式所在的行，又该如何查找？还有一些情况，比如，在第一行和最后一行之间存在着空行；各列的最后一行不相同，在工作表无数据区域中虽没有数据但已设置了格式……等等。
当然，在Excel中，有许多可以用来查找最后一行的方法，比如End(xlUp)属性、UsedRange属性、CurrentRegion属性、SpecialCells方法、以及Find方法等，这些方法可以在不同的情形下使用。但正如前面所讲述的，关键是要清楚Excel将“已使用范围”、“当前区域”、和一些常量如xlCellTypeLastCell在工作表中代表什么区域，以及您是在什么情形下查找最后一行，然后选用合适的方法，以确保找到正确的最后一行，否则，可能所找到的并不是您所想要的最后一行。
“最后一行”可能的情形
在查找最后一行时，可能是查找以下情形单元格所在的“最后一行”，即：

  • 含有公式的单元格
  • 格式化的单元格
  • 含有颜色的单元格
  • 包含数据有效性的单元格
  • 包含批注的单元格
  • 直接输入数据(文本和/或数字)的单元格
  • 由公式生成数据(文本和/或数字)的单元格
  • 直接输入数据(文本和/或数字)或者由公式生成数据(文本和/或数字)的单元格
  • 直接输入数字的单元格
  • 由公式生成数字的单元格
  • 直接输入数字或由公式生成数字的单元格
  • 直接输入文本的单元格
  • 由公式生成文本的单元格
  • 直接输入文本或由公式生成文本的单元格
  • 其它情形
  • 包含上述所有情形的单元格

此外，还需要考虑工作表中的最后一行是否被隐藏了，而哪些方法忽略隐藏的行？最后一行的单元格中的数据是否显示？这些都会影响到您是否能查找到正确的最后一行。
下面，我们来讨论查找最后一行的方法以及可能出现的一些情况。
找到最后一行的一些方法探讨
使用End属性
在Excel VBA中，使用End(xlUp)查找最后一行是最常使用且最为简单的方法，它假设有一列总会包含有数据（数字、文本和公式等），并且在该列中最后输入数据的单元格的下一行不会包含数据，因此不必担心会覆盖掉已有数据。但该方法有两个缺点：
（1）仅局限于查找指定列的最后一行。
（2）如果该列中最后一行被隐藏，那么该隐藏行将被视作最后一行。因此，在最后一行被隐藏时，其数据可能会被覆盖。但该列中间的隐藏行不会影响查找的结果。
[示例代码01]

Sub EndxlUp_OneColLastRow()
    If Range("A" & Rows.Count).End(xlUp) = Empty Then GoTo Finish
    '获取最后一行
    MsgBox "最后一行是第" & Range("A" & Rows.Count).End(xlUp).Row & "行."
    Exit Sub
Finish:
    MsgBox "没有发现公式或数据! "
End Sub

[示例代码02]

Sub NextRowInColumnUsedAsSub()
    '包含所有数据和公式，忽略隐藏的最后一行
    Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1).Select
End Sub

[示例代码03]

Sub NextRowInColumnUsedAsFunction()
    '包含所有数据和公式，忽略隐藏的最后一行
    Range("A" & LastRowInColumn("A") + 1).Select
End Sub
 
Public Function LastRowInColumn(Column As String) As Long
     LastRowInColumn = Range(Column & Rows.Count).End(xlUp).Row
End Function

注意，要输入新数据的列可能与我们所查找最后一行时所使用的列不同，例如，在上例中，我们可以修改为在B列中查找该列的最后一行，而在A列相应行的下一行中输入新的数据。
使用Find方法
Find方法在当前工作表数据中进行查找，不需要指定列，也可以确保不会意外地覆盖掉已有数据。其中，参数LookIn指定所查找的类型，有三个常量可供选择，即xlValues、xlFormulas和xlComments。
(1) 常量xlFormulas将包含零值的单元格作为有数据的单元格。（当设置零值不显示时，该单元格看起来为空，但该参数仍将该单元格视为有数据的单元格）
(2) 常量xlValues将包含零值的单元格（如果设置零值不显示时）作为空白单元格，此时，若该单元格在最后一行，则Find方法会认为该单元格所在的行为空行，因此，该单元格中的内容可能会被新数据所覆盖。
[注：在Excel中，选择菜单“工具”——“选项”，在打开的“选项”对话框中，选择“视图”选项卡，将其中的“零值”前的复选框取消选中，则工作表中的零值都不会显示]
如果在参数LookIn中使用常量xlValues的话，还存在一个问题是：如果您将最后一行隐藏，则Find方法会认为倒数第二行是最后一行，此时您在最后一行的下一行输入数据，则会将实际的最后一行的数据覆盖。
您可以在隐藏最后一行与不隐藏最后一行，或者是最后一行显示零值与不显示零值时，运行下面的示例代码04，看看所得的结果有什么不同。
[示例代码04]

Sub Find_LastRowxlValues()
    On Error GoTo Finish
    '获取最后一行
    MsgBox "最后一行是第" & Cells.Find("*", _
      SearchOrder:=xlByRows, LookIn:=xlValues, _
      SearchDirection:=xlPrevious).EntireRow.Row & "行"
    Exit Sub
Finish:
    MsgBox "没有发现数值！"
End Sub

因此，在使用Find方法时，您应该考虑所选参数设置的常量，以及工作表最后一行是否有可能被隐藏或不显示零值。如果您忽视这些情况，很可能得不到您想要的结果，或者是覆盖掉已有数据。使用常量xlFormulas可以避免这个问题，如下面的示例代码05所示。
[示例代码05]

Sub Find_LastRowxlFormulas()
    On Error GoTo Finish
    '获取最后一行
    MsgBox "最后一行是第" & Cells.Find("*", _
      SearchOrder:=xlByRows, LookIn:=xlFormulas, _
      SearchDirection:=xlPrevious).EntireRow.Row & "行"
    Exit Sub
Finish:
    MsgBox "没发现数值或公式！"
End Sub

下面再列举几个示例代码。
[示例代码06]

Sub NextRowUsedAsSub()
    '选取最后一行的下一行
    Range("A" & Cells.Find("*", LookIn:=xlFormulas, SearchDirection:=xlPrevious).Row + 1).Select
End Sub

[示例代码07]

Sub NextRowUsedAsFunction()
    '选取最后一行的下一行(调用函数)
    Range("A" & LastRow + 1).Select
End Sub
 
Public Function LastRow() As Long
    '本代码包含隐藏行
    '使用常量xlFormulas，因为常量xlValues会忽略隐藏的最后一行
    LastRow = Cells.Find("*", LookIn:=xlFormulas, SearchDirection:=xlPrevious).Row
End Function

注：Find方法中，参数LookIn的默认值为xlFormulas。
使用SpecialCells方法
SpecialCells方法用于查找指定类型的值，其语法为SpecialCells(Type,Value)，有两种主要的使用方式：
（1）若参数Type仅考虑常量，则在查找时会忽略和覆盖由公式生成的任何数据，如示例代码08所示。
（2）若参数Type仅考虑由公式生成的数据，则在查找时会忽略和覆盖任何常量数据，如示例代码09所示。
如果参数Type是xlCellTypeConstants或者是xlCellTypeFormulas，则Value参数可使用常量决定哪种类型的单元格将被包含在结果中，这些常量值能组合而返回多个类型，其缺省设置是选择所有的常量或公式，而不管是何类型，可使用下面四个可选的常量：
1）xlTextValues（包含文本） 2）xlNumbers（包含数字）
3）xlErrors（包含错误值） 4）xlLogical（包含逻辑值）
自已在工作表输入一些含有数值和公式的数据，隐藏或不隐藏最后一行或公式所在的行，体验下面的两段示例代码。
[示例代码08]

'当最后一行为公式或隐藏了最后行时，会忽略，即认为倒数第二行为最后一行
Sub NextConstantRowFunction()
Range("A" & LastConstantRow(True, True, True, True) + 1).Select
End Sub
 
Public Function LastConstantRow(Optional IncludeText As Boolean, _
                               Optional IncludeNumbers As Boolean, _
                               Optional IncludeErrors As Boolean, _
                               Optional IncludeLogicals As Boolean) As Long
   Dim Text As Long, Numbers As Long, Errors As Long
Dim Logical As Long, AllTypes As Long
   If IncludeText Then Text = xlTextValues Else Text = 0
   If IncludeNumbers Then Numbers = xlNumbers Else Numbers = 0
   If IncludeErrors Then Errors = xlErrors Else Errors = 0
   If IncludeLogicals Then Logical = xlLogical Else Logical = 0
   AllTypes = Text + Numbers + Errors + Logical
   On Error GoTo Finish
   LastConstantRow = Split(Cells.SpecialCells(xlCellTypeConstants, AllTypes).Address, "$") _
       (UBound(Split(Cells.SpecialCells(xlCellTypeConstants, AllTypes).Address, "$")))
     Exit Function
Finish:
     MsgBox "没有发现数据！"
End Function

[示例代码09]

'查找含有公式的单元格所在的行，忽略该行以后的常量和隐藏的行
Sub NextFormulaRowFunction()
     Range("A" & LastFormulaRow(True, True, True, True) + 1).Select
End Sub
 
Public Function LastFormulaRow(Optional IncludeText As Boolean, _
                               Optional IncludeNumbers As Boolean, _
                               Optional IncludeErrors As Boolean, _
                               Optional IncludeLogicals As Boolean) As Long
    Dim Text As Long, Numbers As Long, Errors As Long
    Dim Logical As Long, AllTypes As Long
    If IncludeText Then Text = xlTextValues Else Text = 0
    If IncludeNumbers Then Numbers = xlNumbers Else Numbers = 0
    If IncludeErrors Then Errors = xlErrors Else Errors = 0
    If IncludeLogicals Then Logical = xlLogical Else Logical = 0
    AllTypes = Text + Numbers + Errors + Logical
    On Error GoTo Finish
    LastFormulaRow = Split(Cells.SpecialCells(xlCellTypeFormulas, AllTypes).Address, "$") _
      (UBound(Split(Cells.SpecialCells(xlCellTypeFormulas, AllTypes).Address, "$")))
    Exit Function
Finish:
    MsgBox "没有发现数据！"
End Function

下面的示例代码10忽略最后一行带有公式的单元格，即当最后一行的单元格中含有公式时，将倒数第二行作为最后一行，即只考虑直接输入到工作表中的数据。当最后一行没有公式但被隐藏时，并不影响该方法的判断。
[示例代码10]

Sub SpecialCells_LastRowxlCellTypeConstants()
   Dim MyRow As Range
   On Error GoTo Finish
   Set MyRow = Intersect([A:A], Cells. _
   SpecialCells(xlCellTypeConstants).EntireRow).EntireRow
   '获取最后一行
   MsgBox "最后一行是第" & Split(MyRow.Address, "$") _
   (UBound(Split(MyRow.Address, "$"))) & "行"
   Set MyRow = Nothing
   Exit Sub
Finish:
   MsgBox "没有发现数据！"
End Sub

注：因为上述代码使用了“Split函数”，故只适合于Office2000及以上的版本。
该方法也允许我们指定单个数据类型，诸如数字数据或文本数据，如下所示。
下面，我们查找的最后一行是仅在行中有数字（而不包含公式）的单元格的最后一行。
[示例代码11]

Sub SpecialCells_LastRowxlCellTypeNumberConstants()
   Dim MyRow As Range
   On Error GoTo Finish
   Set MyRow = Intersect([A:A], Cells. _
   SpecialCells(xlCellTypeConstants, xlNumbers).EntireRow)
   '获取最后一行
   MsgBox "最后一行是第" & Split(MyRow.Address, "$") _
   (UBound(Split(MyRow.Address, "$"))) & "行"
   Set MyRow = Nothing
   Exit Sub
Finish:
   MsgBox "没有发现数据！"
End Sub

下面，我们查找的最后一行是仅在行中有文本（而不包含公式）的单元格的最后一行。
[示例代码12]

Sub SpecialCells_LastRowxlCellTypeTextConstants()
   Dim MyRow As Range
   On Error GoTo Finish
   Set MyRow = Intersect([A:A], Cells. _
   SpecialCells(xlCellTypeConstants, xlTextValues).EntireRow)
   '获取最后一行
   MsgBox "最后一行是第" & Split(MyRow.Address, "$") _
   (UBound(Split(MyRow.Address, "$"))) & "行"
   Set MyRow = Nothing
   Exit Sub
Finish:
   MsgBox "没有发现数据！"
End Sub

下面，我们查找的最后一行是仅在行中有公式的单元格的最后一行。
[示例代码13]

Sub SpecialCells_LastRowxlCellTypeFormulas()
   Dim MyRow As Range
   On Error GoTo Finish
   Set MyRow = Intersect([A:A], Cells. _
   SpecialCells(xlCellTypeFormulas).EntireRow).EntireRow
   '获取最后一行
   MsgBox "最后一行是第" & Split(MyRow.Address, "$") _
   (UBound(Split(MyRow.Address, "$"))) & "行"
   Set MyRow = Nothing
   Exit Sub
Finish:
   MsgBox "没有发现数据！"
End Sub

同上面所讲述的一样，我们也能使用SpecailCells方法去找到其它特定类型的单元格所在的最后一行，下面是这些常量的完整列表：
XlCellTypeAllFormatConditions (任何格式的单元格)
XlCellTypeAllValidation (带有数据有效性的单元格)
XlCellTypeBlanks (所使用区域中的空白单元格)
XlCellTypeComments (包含有批注的单元格)
XlCellTypeConstants (包含有常量的单元格)
XlCellTypeFormulas (包含有公式的单元格)
XlCellTypeLastCell (已使用区域中的最后一个单元格(看下面))
XlCellTypeSameFormatConditions (有相同格式的单元格)
XlCellTypeSameValidation (有相同数据有效性条件的单元格)
XlCellTypeVisible (工作表中所有可见的单元格)
使用UsedRange属性（及SpecialCells方法）
UsedRange方法可用于在工作表中已使用区域查找最后一行，该区域包括可能以前使用过的任何单元格，但现在其中的数据被删除了，比如目前的工作表中只有第1行至第5行共5行，其它行都无数据，但在第6行中有些单元格以前使用过（可能仅仅格式化或内容清除了，总之该行现在不含有数据），那么第6行也包含在该已使用的区域中。此外，如果最后一行被隐藏，那么使用该方法查找最后一行是无规律且不可靠的，它通常可能会得到预料不到的结果。
有时，与UsedRange属性相似的技术也能用SpecialCells方法实现，其常量xlCellTypeLastCell代表在“已使用区域”中的最后一个单元格，与UsedRange属性稍有不同的是，当您在最后一行中输入数据后，又将其删除，则此数据所在的单元格也包含在已使用的区域中，并且如果最后的行被隐藏，则将可见行的最后一行当作最后一行。下面有两段代码您可以在工作表中进行调试，看看其特点。
[示例代码14]

Sub NextUsedRowSub()
    ' 选取可见的最后一行的下一行
    Range("A" & Cells.SpecialCells(xlCellTypeLastCell).Row + 1).Select
End Sub

[示例代码15]

Sub NextUsedRowFunction()
    Range("A" & LastUsedRow + 1).Select
End Sub
 
Public Function LastUsedRow() As Long
    LastUsedRow = Cells.SpecialCells(xlCellTypeLastCell).Row
End Function

使用这里介绍的两种技术时，您一定要清楚工作表当前的状态，以找到正确的最后一行。
使用CurrentRegion属性
CurrentRegion属性返回代表单元格所在的当前区域，即四周有空行的独立区域，因此，可使用此属性查找当前区域的最后一行。但是使用其查找最后一行的一个缺点是，必须首先选取当前区域，然后进行查找。
交叉参考
在《在汇总工作表中合并多个工作表中的数据》和《将多个工作簿中的数据合并到一个工作簿》中也有查找最后一个单元格、最后一行或最后一列的优秀代码示例。
小结
正如开始所讲述的一样，使用各种方法来查找最后一行都有其优缺点，并且都能找到您想要的最后一行，关键是您要了解各种方法的特性，以及工作表的状态，以便于选择所使用的方法来找到您需要的最后一行。
上述内容可能有不准确的地方，也可能有遗漏之处，您也可以在调试中体会和改进。

相关文章

标签：, , , , , ,
分类目录： VBA  |  2 评论  | 1,208 次阅读

Range对象应用大全(1)-应用基础

2009年06月27日, 8:51 下午
1 颗星2 颗星3 颗星4 颗星5 颗星 (4 人投票, 平均: 4.75 out of 5)
Loading ... Loading ...

引子：本文以MSDN中《Developers Guide to the Excel 2007 Range Object》一文为线索，整理并归纳了自已以前学习Range对象时的一系列学习笔记。辑录于此，供有兴趣的朋友参考。
毫无疑问，Range对象是Excel对象模型中最重要的对象，几乎所有与工作表有关的实质性操作都涉及到Range对象，可以说，熟悉并熟练运用Range对象是掌握Excel VBA编程的关键。下面，让我们逐步了解、熟悉并开始使用Range对象吧。

在VBA代码中引用或选择Excel工作表的单元格或单元格区域

在使用Excel VBA编程时，我们通常需要频繁地引用单元格区域，然后再使用相应的属性和方法对区域进行操作。所谓单元格区域，指的是单个的单元格、或者包含连续或非连续的多个单元格组成的区域、或者是整行、整列、甚至是三维单元格区域等。
[应用1]引用当前工作表中的单个单元格（例如引用单元格C3）
可以使用下面列举的任一方式引用当前工作表中的单元格（C3）：
（1）Range(“C3″)
（2）[C3]
（3）Cells(3, 3)
（4）Cells(3, “C”)
（5）Range(“C4″).Offset(-1)
Range(“D3″).Offset(, -1)
Range(“A1″).Offset(2, 2)
（6）若C3为当前单元格，则可使用：ActiveCell
（7）若将C3单元格命名为“Range1”，则可使用：Range(“Range1″)或[Range1]
（8）Cells(4, 3).Offset(-1)
（9）Range(“A1″).Range(“C3″)
此外，可以使用下面的代码选择当前工作表中的单元格D5：
ActiveSheet.Cells(5, 4).Select
或：ActiveSheet.Range(“D5″).Select
[应用2]引用当前工作表中的B2:D6单元格区域
可以使用下面列举的任一方式引用当前工作表中的单元格区域B2:D6：
（1）Range(“B2:D6”)
（2）Range(“B2″, “D6″)
（3）[B2:D6]
（4）Range(Range(“B2″), Range(“D6″))
（5）Range(Cells(2, 2), Cells(6, 4))
（6）若将B2:D6区域命名为“MyRange”，则又可以使用下面的语句引用该区域：
① Range(“MyRange”)
② [MyRange]
（7）Range(“B2″).Resize(5, 3)
（8）Range(“A1:C5″).Offset(1, 1)
（9）若单元格B2为当前单元格，则可使用语句：Range(ActiveCell, ActiveCell.Offset(4, 2))
（10）若单元格D6为当前单元格，则可使用语句：Range(“B2″, ActiveCell)
下面的过程将单元格区域 A1:D5 的字体设置为加粗。

Sub FormatRange()
    Workbooks("Book1").Sheets("Sheet1").Range("A1:D5") _
        .Font.Bold = True
End Sub

Range(“A:A”)代表当前工作表中的A 列，Range(“1:1″)代表当前工作表中的第一行，Range(“A:C”)代表当前工作表中从 A 列到 C 列的区域，Range(“1:5″)代表当前工作表中从第一行到第五行的区域，Range(“1:1,3:3,8:8″)代表当前工作表中第 1、3 和 8 行，Range(“A:A,C:C,F:F”)代表当前工作表中的第A、C和F 列。
下面是给单元格赋值的几个例子。
示例1：

Sub test1()
    Worksheets("Sheet1").Range("A5").Value = 22
    MsgBox "工作表Sheet1内单元格A5中的值为" _
       & Worksheets("Sheet1").Range("A5").Value
End Sub

示例2：

Sub test2()
    Worksheets("Sheet1").Range("A1").Value = _
    Worksheets("Sheet1").Range("A5").Value
    MsgBox "现在A1单元格中的值也为" & _
        Worksheets("Sheet1").Range("A5").Value
End Sub

示例3：

Sub test3()
    MsgBox "用公式填充单元格,本例为随机数公式"
    Range("A1:H8").Formula = "=Rand()"
End Sub

示例4：

Sub test4()
    Worksheets(1).Cells(1, 1).Value = 24
    MsgBox "现在单元格A1的值为24"
End Sub

示例5：

Sub test5()
    MsgBox "给单元格设置公式,求B2至B5单元格区域之和"
    ActiveSheet.Cells(2, 1).Formula = "=Sum(B1:B5)"
End Sub

示例6：

Sub test6()
    MsgBox "设置单元格C5中的公式."
    Worksheets(1).Range("C5:C10").Cells(1, 1).Formula = "=Rand()"
End Sub

示例7：

Sub test7()
    MsgBox "给命名区域赋值."
    ActiveSheet.Range("MyCell").Value = 1
End Sub

其中，MyCell为单元格区域的名称。
[应用3]引用当前工作表中不确定的单元格区域
有时，我们需要在代码中依次获取工作表中特定区域内的单元格，这通常可以采取下面的几种方式：
（1）Range(“A” & i)
（2）Range(“A” & i & “:C” & i)
（3）Cells(i,1)
（4）Cells(i,j)
其中，i、j为变量，在循环语句中指定i和j的范围后，依次获取相应单元格。
在下例中，Cells(6,1)返回Sheet1上的单元格A6，然后将Value属性设置为 10。

Sub EnterValue()
    Worksheets("Sheet1").Cells(6, 1).Value = 10
End Sub

因为可以用变量替代编号，所以Cells属性非常适合于在单元格区域中循环，如下例中所示。

Sub CycleThrough()
    Dim Counter As Integer
    For Counter = 1 To 20
        Worksheets("Sheet1").Cells(Counter, 3).Value = Counter
    Next Counter
End Sub

如果要同时更改某个区域中所有单元格的属性（或将方法应用于该区域中的所有单元格），建议使用Range属性。
[应用4]扩展引用当前工作表中的单元格区域
可以使用Resize属性，例如：
（1）ActiveCell.Resize(4, 4)，表示自当前单元格开始创建一个4行4列的区域。
（2）Range(“B2″).Resize(2, 2)，表示创建B2:C3单元格区域。
（3）Range(“B2″).Resize(2)，表示创建B2:B3单元格区域。
（4）Range(“B2″).Resize(, 2)，表示创建B2:C2单元格区域。
如果是在一个单元格区域（如B3:E6），或者一个命名区域中（如将单元格区域B3:E6命名为“MyRange”）使用Resize属性，则只是相对于单元格区域左上角单元格扩展区域，例如：
代码Range(“C3:E6″).Resize(, 2)，表示单元格区域C3：D6，并且扩展的单元格区域可以不在原单元格区域内。
因此，可以知道Resize属性是相对于当前活动单元格或某单元格区域中左上角单元格按指定的行数或列数扩展单元格区域。
再举一些例子。
例1：要选择当前工作表中名为“Database”区域，然后将该区域向下扩展5行，可以使用下面的代码：

Range("Database").Select
Selection.Resize(Selection.Rows.Count + 5, Selection.Columns.Count).Select

例2：选择名为“Database”区域下方4行右侧3列的一个区域，然后扩展2行和1列，可以使用下面的代码：

Range("Database").Select
Selection.Offset(4, 3).Resize(Selection.Rows.Count + 2, Selection.Columns.Count + 1).Select

[应用5]在当前工作表中基于当前单元格区域或指定单元格区域处理其它单元格区域
可以使用Offset属性，例如：
（1）Range(“A1″).Offset(2, 2)，表示单元格C3。
（2）ActiveCell.Offset(, 1)，表示当前单元格下一列的单元格。
（3）ActiveCell.Offset(1)，表示当前单元格下一行的单元格。
（4）Range(“C3:D5″).Offset(, 1)，表示单元格区域D3:E5，即将整个区域偏移一列。
从上面的代码示例可知，Offset属性从所指定的单元格开始按指定的行数和列数偏移，从而到达目的单元格，但偏移的行数和列数不包括指定单元格本身。正值表示向下和向右，负值表示向上和向左，零值则是指当前单元格。
例如，要选择距当前单元格下面5行左侧4列的单元格，可以使用下面的代码：

ActiveCell.Offset(5, -4).Select

要选择距当前单元格上方2行右侧3列的单元格，可以使用下面的代码：

ActiveCell.Offset(-2, 3).Select

注意：一定要保证当前单元格与所选单元格之间的距离在工作表范围内，否则会出错。
又如，要选择距单元格C7下方5行右侧4列的单元格，可以使用下面的代码：

ActiveSheet.Cells(7, 3).Offset(5, 4).Select

或：

ActiveSheet.Range("C7").Offset(5, 4).Select

再举一些例子。
例如，要选择与名为“Test”的区域大小相同但在该区域下方4行右侧3列的一个区域，可以使用下面的代码：

ActiveSheet.Range("Test").Offset(4, 3).Select

如果该命名区域不在当前工作表中，可以先激活该工作表，然后再选择，如下面的代码：

Sheets("Sheet3").Activate
ActiveSheet.Range("Test").Offset(4, 3).Select

下面的例子计算移动平均值：

Sub MovingAvg()
    Dim rng As Range
    Dim lngRow As Long
    Set rng = Range("B1:B3")
    For lngRow = 3 To 12
        Cells(lngRow, "C").Value = WorksheetFunction.Sum(rng) / 3
        Set rng = rng.Offset(1, 0)
    Next lngRow
End Sub

上述代码首先将B列中的前3个单元格设置为一个单元格区域，计算其平均值，并放置在单元格C3中。接着，Offset属性将单元格区域下移一行但仍在B列，计算单元格区域B2：B4的平均值，并将结果放置到单元格C4。代码重复上述过程直到单元格B12。
[应用6]在当前工作表中引用交叉区域
可以使用Intersect方法，例如：

Intersect(Range("C3:E6"), Range("D5:F8"))

表示单元格区域D5:E6，即单元格区域C3:E6与D5:F8相重迭的区域。
又如，要选择名为“Test”和“Sample”的两个区域的交叉区域，可以使用下面的代码：

Application.Intersect(Range("Test"), Range("Sample")).Select

注意，两个区域必须在同一工作表中。
注意，如果两个区域不存在交叉，那么该方法返回Nothing。
例如，下面的代码选择两个命名区域的交叉部分，如果不存在交叉，则显示一条消息。

Sub IntersectSample()
    Worksheets("Sheet1").Activate
    Set Intersect = Application.Intersect(Range("rng1"), Range("rng2"))
    If Intersect Is Nothing Then
        MsgBox "不存在交叉区域."
    Else
        Intersect.Select
    End If
End Sub

[应用7]在当前工作表中引用多个区域
（1）可以使用Union方法，将多个区域组合到一个Range对象中。例如：

Union(Range("C3:D4"), Range("E5:F6"))

表示单元格区域C3:D4和E5:F6所组成的区域。
Union方法可以将多个非连续区域连接起来成为一个区域，从而可以实现对多个非连续区域一起进行操作。
（2）也可以使用下面的代码，即通过在两个或多个引用之间插入逗号，可使用Range属性引用多个区域：

Range("C3:D4, E5:F6")

或

[C3:D4, E5:F6]

注意：Range(“C3:D4″, “F5:G6″)，表示单元格区域C3:G6，即将两个区域以第一个区域左上角单元格为起点，以第二个区域右下角单元格为终点连接成一个新区域。
同时，在引用区域后使用Rows属性和Columns属性时，注意下面代码的区别：
①Range(“C3:D4″, “F8:G10″).Rows.Count，返回的值为8；
②Range(“C3:D4,F8:G10″).Rows.Count，返回的值为2，即只计算第一个单元格区域。
（3）可用Areas属性引用选定的单元格区域或多块选定区域中的区域集合。
例1：以下示例清除了 Sheet1 上三个区域的内容。

Sub ClearRanges()
    Worksheets("Sheet1").Range("C5:D9,G9:H16,B14:D18"). _
        ClearContents
End Sub

命名区域使得用Range属性处理多个区域更加容易。以下示例可在所有这三个命名区域处于同一工作表时运行。

Sub ClearNamed()
    Range("MyRange, YourRange, HisRange").ClearContents
End Sub

例2：为了同时选择名为“Test”和“Sample”的两个区域，可以使用下面的代码：

Application.Union(Range("Test"), Range("Sample")).Select

注意，这两个区域须在同一工作表中，如下面的代码：

Set y = Application.Union(Range("Sheet1!A1:B2"), Range("Sheet1!C3:D4"))

但Union方法不能处理不同工作表中的区域，可下面的代码：

Set y = Application.Union(Range("Sheet1!A1:B2"), Range("Sheet2!C3:D4"))

将会出错。
例3：以下示例创建了名为 myMultipleRange 的 Range 对象，并将其定义为区域 A1:B2 和 C3:D4 的组合，然后将该组合区域的字体设置为加粗。

Sub MultipleRange()
    Dim r1, r2, myMultipleRange As Range
    Set r1 = Sheets("Sheet1").Range("A1:B2")
    Set r2 = Sheets("Sheet1").Range("C3:D4")
    Set myMultipleRange = Union(r1, r2)
    myMultipleRange.Font.Bold = True
End Sub

例4：下述过程计算选定区域中的块数目，如果有多个块，就显示一则警告消息。

Sub FindMultiple()
    If Selection.Areas.Count > 1 Then
        MsgBox "不能对多个选区进行操作."
    End If
End Sub

[应用8]引用当前工作表中活动单元格或指定单元格所在的区域（当前区域）
可以使用CurrentRegion属性，例如：
（1）ActiveCell.CurrentRegion，表示活动单元格所在的当前区域。
（2）Range(“D5″).CurrentRegion，表示单元格D5所在的当前区域。
当前区域是指周围由空行或空列所围成的区域。
下面的示例将当前工作表当前区域的值复制到剪贴板，然后将这些值插入到新工作表：

Sub CopyCurrentRegionValue()
    Range("D5").Activate
    ActiveCell.CurrentRegion.Select
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = "Sample"
    Sheets("Sample").Select
    Range("D5").Activate
    ActiveSheet.Paste
End Sub

[应用9]引用当前工作表中已使用的区域
可以使用UsedRange属性，例如：
（1）Activesheet.UsedRange，表示当前工作表中已使用的区域。
（2）Worksheets(“sheet1″).UsedRange，表示工作表sheet1中已使用的区域。
与CurrentRegion属性不同的是，该属性代表工作表中已使用的单元格区域，包括显示为空行，但已进行过格式的单元格区域。

'选取当前工作表中已使用的单元格区域
Sub SelectUsedRange()
    MsgBox "选取当前工作表中已使用的单元格区域" _
       & vbCrLf & "并显示其地址"
    ActiveSheet.UsedRange.Select
    MsgBox ActiveSheet.UsedRange.Address
End Sub

[应用10]在单元格区域内指定特定的单元格
可以使用Item属性，例如：
（1）Range(“A1:B10″).Item(5,3)指定单元格C5，这个单元格处于以区域中左上角单元格A1（即区域中第1行第1列的单元格）为起点的第5行第3列。因为Item属性为默认属性，因此也可以简写为：Range(“A1:B10″)(5,3)。
如果将A1:B10区域命名为”MyRange”，那么Range(“MyRange”)(5,3)也指定单元格C5。
（2）Range(“A1:B10″)(12,13)指定单元格M12，即用这种方式引用单元格，该单元格不必一定要包含在区域内。
同时，也不需要索引数值是正值，例如：
① Range(“D4:F6″)(0,0)代表单元格C3；
② Range(“D4:F6″)(-1,-2)代表单元格A2。
而Range(“D4:F6″)(1,1)代表单元格D4。
（3）也可以在单元格区域中循环，例如：
Range(“D4:F6″)(2,2)(3,4)代表单元格H7，即该单元格位于作为左上角单元格E5的第3行第4列(因为E5是开始于区域中左上角单元格D4起的第2行第2列)。
（4）也能使用一个单个的索引数值进行引用。计数方式为从左向右，即在区域中的第一行开始从左向右计数，第一行结束后，然后从第二行开始从左到右接着计数，依次类推。(注：从区域中第一行第一个单元格开始计数，当第一行结束时，转入第二行最左边的单元格，这样按一行一行从左向右依次计数。以单元格区域中第1个单元格开始，按上述规则依次为第2个单元格、第3个单元格….等等)，例如：
Range(“A1:B2″)(1) 代表单元格A1；
Range(“A1:B2″)(2) 代表单元格B1；
Range(“A1:B2″)(3) 代表单元格A2；
Range(“A1:B2″)(4) 代表单元格B2。
这种方法可在工作表中连续向下引用单元格(即不一定是在单元格区域内，但在遵循相同的规律)，例如：
Range(“A1:B2″)(5)代表单元格A3；
Range(“A1:B2″)(14)代表单元格B7，等等。
也可以使用单个的负数索引值。
这种使用单个索引值的方法对遍历列是有用的，例如，Range(“D4″)(1)代表单元格D4，Range(“D4″)(2)代表单元格D5，Range (“D4″)(11)代表单元格D14，等等。
同理，稍作调整后也可遍历行，例如：
Range(“D4″).Columns(2)代表单元格E4，Range(“D4″).Columns(5)指定单元格H4，等等。
（5）当与对象变量配合使用时，Item属性能提供简洁并有效的代码，例如：

Set rng = Worksheets(1).[A1]

定义了对象变量后，像单元格方法一样，Item属性允许使用两个索引数值引用工作表中的任一单元格，例如，rng(3,4)指定单元格D3。
[应用11]引用当前工作表中的整行或整列
见下面的示例代码：
（1）Range(“C:C”).Select，表示选择C列。
Range(“C:E”).Select，表示选择C列至E列。
（2）Range(“1:1″).Select，表示选择第一行。
Range(“1:3″).Select，表示选择第1行至第3行。
（3）Range(“C:C”).EntireColumn，表示C列；
Range(“D1″).EntireColumn，表示D列。
同样的方式，也可以选择整行，然后可以使用如AutoFit方法对整列或整行进行调整。
此外，可用Rows属性或Columns属性来处理整行或整列。这两个属性返回代表单元格区域的Range对象。在下例中，Rows(1)返回Sheet1上的第一行，然后将区域字体加粗。

Sub RowBold()
    Worksheets("Sheet1").Rows(1).Font.Bold = True
End Sub

另，Rows(1)代表当前工作表中的第一行，Rows代表当前工作表中的所有的行，Columns(1)代表当前工作表中的第一列，Columns(“A”)代表当前工作表中的第一列，Columns代表当前工作表中所有的列。
若要同时处理若干行或列，可创建一个对象变量并使用Union方法，将对Rows属性或Columns属性的多个调用组合起来。下例将活动工作簿中第一张工作表上的第一行、第三行和第五行的字体设置为加粗。

Sub SeveralRows()
    Worksheets("Sheet1").Activate
    Dim myUnion As Range
    Set myUnion = Union(Rows(1), Rows(3), Rows(5))
    myUnion.Font.Bold = True
End Sub

[应用12]引用当前工作表中的所有单元格
可以使用下面的代码：
（1）Cells，表示当前工作表中的所有单元格。
（2）Range(Cells(1, 1), Cells(Cells.Rows.Count, Cells. Columns.Count))，其中Cells.Rows表示工作表所有行，Cells. Columns表示工作表所有列。
下面的过程清除活动工作簿中Sheet1上所有单元格的内容。

Sub ClearSheet()
    Worksheets("Sheet1").Cells.ClearContents
End Sub

[应用13]引用工作表中的特定单元格区域
在工作表中，您可能使用过“定位条件”对话框。可以通过选择菜单“编辑——定位”，单击“定位”对话框中的“定位条件”按钮显示该对话框。这个对话框可以允许用户选择特定的单元格。例如：
（1）Worksheets(“sheet1″).Cells.SpecialCells(xlCellTypeAllFormatConditions)，表示工作表sheet1中由带有条件格式的单元格所组成的区域。
（2）ActiveCell.CurrentRegion.SpecialCells(xlCellTypeBlanks)，表示当前工作表中活动单元格所在区域中所有空白单元格所组成的区域。
（3）选择所有公式单元格

Sub SelectSpecialCells()
    MsgBox "选择当前工作表中所有公式单元格"
    ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas).Select
End Sub

当然，还有很多常量和值的组合，可以让您实现特定单元格的查找并引用。
[应用14]引用命名区域
使用名称比使用A1样式记号更容易标识单元格区域。若要命名选定的单元格区域，请单击编辑栏左端的名称框，键入名称，再按回车键。
例1：要选择当前工作表中名为“Test”的区域，可以使用下面的代码：

Range("Test").Select

或：

Application.Goto "Test"

例2：选择同一工作簿中另一工作表上名为“Test”的区域，可使用下面的代码：

Application.Goto Sheets("Sheet1").Range("Test")

也可以先激活工作表，再选择：

Sheets("Sheet1").Activate
Range("Test").Select

例3：要选择不同工作簿中工作表上名为“Test”的区域，可使用下面的代码：

Application.Goto Workbooks("BOOK2.XLS").Sheets("Sheet2").Range("Test")

也可以先激活工作表，再选择：

Workbooks("BOOK2.XLS").Sheets("Sheet2").Activate
Range("Test").Select

例4：以下示例引用名为“MyBook.xls”的工作簿中名为“MyRange”的区域，并将该区域的字体设置为斜体：

Sub FormatRange()
    Range("MyBook.xls!MyRange").Font.Italic = True
End Sub

例5：以下示例引用名为“Report.xls”的工作簿中特定工作表的区域“Sheet1!Sales”，并添加边框线：

Sub FormatSales()
    Range("[Report.xls]Sheet1!Sales").BorderAround Weight:=xlThin
End Sub

例6：要选定命名区域，可以使用GoTo方法。该方法将激活工作簿和工作表，然后选定该区域。

Sub ClearRange()
    Application.Goto Reference:="MyBook.xls!MyRange"
    Selection.ClearContents
End Sub

以下示例显示对于活动工作簿将如何编写与上例相同的过程。

Sub ClearRange()
    Application.Goto Reference:="MyRange"
    Selection.ClearContents
End Sub

例7：下例用For Each…Next循环语句在命名区域中的每一个单元格上循环。如果该区域中的任一单元格的值超过limit的值，就将该单元格的颜色更改为黄色。

Sub ApplyColor()
    Const Limit As Integer = 25
    For Each c In Range("MyRange")
        If c.Value > Limit Then
            c.Interior.ColorIndex = 27
        End If
    Next c
End Sub

[应用15]选择特别指定的单元格或单元格区域
下面的示例使用了如下图1所示的工作表。

图1：示例数据
例1：选择连续数据列中的最后一个单元格
要选择一个列A中最后一个单元格，可以使用下面的代码：

ActiveSheet.Range("A1").End(xlDown).Select

在图1所示的工作表中运行上述代码，将选择单元格A4。

'选取最下方的单元格
Sub SelectEndCell()
    MsgBox "选取当前单元格区域内最下方的单元格"
    ActiveCell.End(xlDown).Select
End Sub

可以改变参数xlDown以选取最左边、最右边、最上方的单元格。
例2：选择连续数据列底部的空单元格
要选择连续单元格区域下面的空单元格，可以使用下面的代码：

ActiveSheet.Range("A1").End(xlDown).Offset(1, 0).Select

在图1所示的工作表中运行上述代码，将选择单元格A5。
例3：选择某列中连续数据单元格区域
要选择列A中连续数据单元格区域，可以使用下面的代码：

ActiveSheet.Range("A1", ActiveSheet.Range("A1").End(xlDown)).Select

或：

ActiveSheet.Range("A1:" & ActiveSheet.Range("A1").End(xlDown).Address).Select

在图1所示的工作表中运行上述代码，将选择单元格区域A1：A4。
例4：选择某列中非连续数据单元格区域
要选择某列中非连续数据单元格区域，可以使用下面的代码：

ActiveSheet.Range("A1", ActiveSheet.Range("A65536").End(xlUp)).Select

或：

ActiveSheet.Range("A1:" & ActiveSheet.Range("A1").End(xlDown).Address).Select

在图1所示的工作表中运行上述代码，将选择单元格区域A1：A6。
例5：选择一个矩形（规则的）单元格区域
要选择围绕某单元格的一个矩形区域，可以使用CurrentRegion属性。CurrentRegion属性将选择四周被空行和空列围绕的区域，如下面的代码：

ActiveSheet.Range("A1").CurrentRegion.Select

在图1所示的工作表中运行上述代码，将选择单元格区域A1：C4。也可以使用下面的代码：

ActiveSheet.Range("A1", ActiveSheet.Range("A1").End(xlDown).End(xlToRight)).Select

或：

ActiveSheet.Range("A1:" & ActiveSheet.Range("A1").End(xlDown).End(xlToRight).Address).Select

若想选择单元格区域A1：C6，可使用下面的代码：

lastCol = ActiveSheet.Range("A1").End(xlToRight).Column
lastRow = ActiveSheet.Cells(65536, lastCol).End(xlUp).Row
ActiveSheet.Range("A1", ActiveSheet.Cells(lastRow, lastCol)).Select

或：

lastCol = ActiveSheet.Range("A1").End(xlToRight).Column
lastRow = ActiveSheet.Cells(65536, lastCol).End(xlUp).Row
ActiveSheet.Range("A1:" & ActiveSheet.Cells(lastRow, lastCol).Address).Select

[应用16]选择多个不同长度的非连续列
例如，有如下图2所示的工作表：

图2：示例数据
要同时选择A列和C列中的数据，即单元格区域A1:A3和C1:C6，可使用下面的代码：

StartRange = "A1"
EndRange = "C1"
Set a = Range(StartRange, Range(StartRange).End(xlDown))
Set b = Range(EndRange, Range(EndRange).End(xlDown))
Union(a, b).Select

[应用17]设置当前单元格的前一个单元格和后一个单元格的值

Sub SetCellValue()
    MsgBox "将当前单元格中前面的单元格值设为""我前面的单元格""" & vbCrLf _
      & "后面的单元格值设为""我后面的单元格"""
    ActiveCell.Previous.Value = "我前面的单元格"
    ActiveCell.Next.Value = "我后面的单元格"
End Sub

[应用18]引用其它工作表或其它工作簿中的单元格区域
要引用其它工作表或其它工作簿中的单元格区域，只需在单元格对象前加上相应的引用对象即可，例如：
（1）Worksheets(“Sheet3″).Range(“C3:D5″)，表示引用工作表sheet3中的单元格区域C3:D5。
（2）Workbooks(“MyBook.xls”).Worksheets(“sheet1″).Range(“B2″)，表示引用MyBook工作簿中工作表Sheet1上的单元格B2。
此外，要选择同一工作簿中另一工作表上的单元格E6，可以使用下面的代码：

Application.Goto ActiveWorkbook.Sheets("Sheet2").Cells(6, 5)

或：

Application.Goto (ActiveWorkbook.Sheets("Sheet2").Range("E6"))

也可以先激活该工作表，然后再选择：

Sheets("Sheet2").Activate
ActiveSheet.Cells(6, 5).Select

同样，例如要选择另一工作簿中某工作表上的单元格F7，可以使用下面的代码：

Application.Goto Workbooks("BOOK2.XLS").Sheets("Sheet1").Cells(7, 6)

或：

Application.Goto Workbooks("BOOK2.XLS").Sheets("Sheet1").Range("F7")

也可以先激活该工作簿中的工作表，然后再选择：

Workbooks("BOOK2.XLS").Sheets("Sheet1").Activate
ActiveSheet.Cells(7, 6).Select

又如，要选择同一工作簿中另一工作表上的单元格区域D3：E11，可以使用下面的代码：

Application.Goto ActiveWorkbook.Sheets("Sheet3").Range("D3:E11")

或：

Application.Goto ActiveWorkbook.Sheets("Sheet3").Range("D3", "E11")

也可以先激活该工作表，然后再选择：

Sheets("Sheet3").Activate
ActiveSheet.Range(Cells(3, 4), Cells(11, 5)).Select

要选择另一工作簿中某工作表上的单元格区域E4:F12，可以使用下面的代码：

Application.Goto Workbooks("BOOK2.XLS").Sheets("Sheet1").Range("E4:F12")

或：

Application.Goto Workbooks("BOOK2.XLS").Sheets("Sheet1").Range("E4", "F12")

也可以先激活该工作表，然后再选择：

Workbooks("BOOK2.XLS").Sheets("Sheet1").Activate
ActiveSheet.Range(Cells(4, 5), Cells(12, 6)).Select

说明：使用Application.Goto方法，如果指定另一工作表（不是当前工作表）中的指定区域，在Range属性中使用两个Cells属性时，则必须包括Sheets对象，如：

Application.Goto Sheets("Sheet1").Range(Sheets("Sheet1").Range(Sheets("Sheet1").Cells(2, 3), Sheets("Sheet1").Cells(4, 5)))

[应用19]处理三维区域
如果要处理若干工作表上相同位置的单元格区域，可用Array函数选定两张或多张工作表。下例设置三维单元格区域的边框格式。

Sub FormatSheets()
    Sheets(Array("Sheet2", "Sheet3", "Sheet5")).Select
    Range("A1:H1").Select
    Selection.Borders(xlBottom).LineStyle = xlDouble
End Sub

下例应用FillAcrossSheets方法，将Sheet2上区域中的格式和所有数据传送到活动工作簿中所有工作表上的相应区域。

Sub FillAll()
    Worksheets("Sheet2").Range("A1:H1") _
        .Borders(xlBottom).LineStyle = xlDouble
    Worksheets.FillAcrossSheets (Worksheets("Sheet2") _
        .Range("A1:H1"))
End Sub

[应用20]使用Range对象变量引用单元格
如果将对象变量设置为Range对象，即可以使用变量名轻松地操作单元格区域。
以下过程将创建对象变量myRange，然后将活动工作簿中Sheet1上的区域A1:D5赋予该变量。随后的语句用该变量名称代替Range对象，以修改该区域的属性。

Sub Random()
    Dim myRange As Range
    Set myRange = Worksheets("Sheet1").Range("A1:D5")
    myRange.Formula = "=RAND()"
    myRange.Font.Bold = True
End Sub

[应用21]其它的引用方式
对于Excel 2007以前的版本来说：
（1）Cells(15)，表示单元格O1，即可在Cells属性中指定单元格数字来选择单元格，其计数顺序为自左至右、从上到下，又如Cells(257)，表示单元格B1。
（2）Cells(, 256)，表示单元格IV1，但是如果Cells(, 257)，则会返回错误。
Excel 2007中增加了工作表列数和行数，因此上述限制相应改变。
说明：上面的一些代码在选择单元格或单元格区域时，先激活工作表后选择，这只是为了说明的方便。实际上，在操作单元格时，只要引用了相应的单元格或单元格区域，不必先激活工作表。
小结：我们使用VBA对Excel进行处理，一般是对其工作表中的数据进行处理，因此，引用单元格区域是ExcelVBA编程中最基本的操作之一，只有确定了所处理的单元格区域，才能使用相应的属性和方法进行下一步的操作。
上面列举了一些引用单元格区域的情形和方式，可以看出，引用单元格区域有很多方式，有一些可能不常用，可以根据工作表的所处的环境和个人编程习惯进行选择使用。
当然，在编写程序时，也可能会将上面的一些属性联合使用，以达到选取特定操作对象的目的，例如Offset属性、Resize属性、CurrentRegion属性、UsedRange属性等的组合。
下面对Range对象的一些常用属性和方法进行简单的小结。
1、Activate与Select
试验下面的过程：

Sub SelectAndActivate()
    Range("B3:E10").Select
    Range("C5").Activate
End Sub

其结果如下图所示：

图3：Select与Activate
即选取单元格区域B3:E10并将单元格C5选中。
Selection指单元格区域B3：E10，而ActiveCell则是单元格C5；ActiveCell代表单个的单元格，而Selection则可以代表单个单元格，也可以代表单元格区域。
2、Range属性
可以使用Application对象的Range属性引用Range对象，如

Application.Range("B2") '代表当前工作表中的单元格B2

若引用当前工作表中的单元格，也可以忽略前面的Application对象。

Range("A1:D10") '代表当前工作表中的单元格区域A1:D10
Range("A1:A10,C1:C10,E1:E10") '代表当前工作表中非连续的三个区域组成的单元格区域

Range属性也接受指向单元格区域对角的两个参数，如：

Range("A1","D10") '代表单元格区域A1：D10

当然，Range属性也接受单元格区域名称，如：

Range("Data") '代表名为Data的数据区域

Range属性的参数可以是对象也可以是字符串，如：

Range("A1",Range("LastCell"))

3、单元格引用的快捷方式
可以在引用区域两侧加上方括号来快速引用单元格区域，如：
[B2]
[A1:D10]
[A1:A10,C1:C10,E1:E10]
[Data]
但其引用的是绝对区域。
4、Cells属性
可以使用Cells属性来引用Range对象。如：

ActiveSheet.Cells
Application.Cells '引用当前工作表中的所有单元格
Cell(2,2)
Cell(2,"B") '引用单元格B2
Range(Cells(1,1),Cells(10,5)) '引用单元格区域A1:E10

若想在一个单元格区域中循环时，使用Cells属性是很方便的。
也可以使用Cells属性进行相对引用，如：

Range("D10:G20").Cells(2,3) '表示引用单元格区域D10:G20中第2行第3列的单元格，即单元格F11

也可使用语句：Range(“D10″).Cells(2,3)达到同样的引用效果。
5、Offset属性
Offset属性基于当前单元格按所给参数进行偏移，与Cells属性不同的是，它基于0即基准单元格为0，如：
Range(“A10″).Cells(1,1)和Range(“A10″).Offset(0,0)都表示单元格A10
当想引用于基准单元格区域同样大小的单元格区域时，则Offset属性是有用的。
6、Resize属性
可使用Resize属性获取相对于原单元格区域左上角单元格指定大小的区域。
7、SpecialCells方法
SpecialCells方法对应于“定位条件”对话框，如图05-02所示：
图4：“定位条件”对话框
8、CurrentRegion属性
使用CurrentRegion属性可以选取当前单元格所在区域，即周围是空行和空列所围成的矩形区域，等价于“Ctrl+Shift+*”快捷键。
9、End属性
End属性所代表的操作等价于“Ctrl+方向箭”的操作，使用常量xlUp、xlDown、xlToLeft和xlToRight分别代表上、下、左、右箭。
例如，下面的代码汇总活动单元格下方列的值：

Sub SumBelow()
    Dim rng As Range
    '汇总活动单元格下方单元格的值
    With ActiveCell
        Set rng = Range(.Offset(1), .Offset(1).End(xlDown))
        .Formula = "=SUM(" & _
                rng.Address(RowAbsolute:=False, ColumnAbsolute:=False) & ")"
        .Copy Destination:=Range(.Cells(1), .Offset(1).End(xlToRight).Offset(-1))
    End With
End Sub

10、Columns属性和Rows属性
Columns属性和Rows属性分别返回单元格区域中的所有列和所有行。
11、Areas集合
在多个非连续的单元格区域中使用Columns属性和Rows属性时，只是返回第一个区域的行或列，如：

Range("A1:B5,C6:D10,E11:F15").Rows.Count

将返回5。
此时应使用Areas集合来返回区域中每个块的地址，如：

For Each rng In Range("A1:B5,C6:D10,E11:F15").Areas
    MsgBox rng.Address
Next rng

12、Union方法和Intersect方法
当想从两个或多个单元格区域中生成一个单元格区域时，使用Union方法；当找到两个或多个单元格区域共同拥有的单元格区域时，使用Intersect方法。
当然，操作单元格或单元格区域有很多有用的技巧，这需要在实践中总结和归纳。接下来的文章，我们将对Range对象的常用属性和方法进行详解。

声明：本文由完美Excel网站整理，完美Excel保留本文的所有权利，未经许可，任何组织或个人不得以任何方式将本文用于商业作途。其他网站或博客引用本文，请注明原文链接和版权声明。

相关文章

标签：
分类目录： VBA  |  评论  | 799 次阅读
Page 1 of 212