Excel VBA 中的 Range 对象操作技巧
8.1 Range 对象的引用方式
在 VBA 中,可通过多种方式获取或引用一个单元格区域(Range)。常用的方法包括:
Application.ActiveCell:返回当前活动单元格。Application.Selection:返回当前选中的所有单元格区域。Application.Range:基于当前工作表定位范围。Worksheet.Cells:通过行和列索引访问单个单元格。Worksheet.Range:用于指定一个区域,支持多种格式。Worksheet.UsedRange:返回工作表中已使用过的最大区域。CurrentRegion与命名区域(Named Range)也可作为引用来源。
示例:使用 Application 调用 Range
Sub ReferringToRangesI()
Dim rng As Range
Debug.Print Application.ActiveCell.Address
Debug.Print Application.Selection.Address
ThisWorkbook.Worksheets(1).Activate
Set rng = Application.Range("D5")
Debug.Print "Sheet1 激活状态:" & rng.Address
Debug.Print "所属工作表:" & rng.Parent.Name
ThisWorkbook.Worksheets(2).Activate
Set rng = Application.Range("D5")
Debug.Print "Sheet2 激活状态:" & rng.Address
Debug.Print "所属工作表:" & rng.Parent.Name
Set rng = 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 Cells 与 Range 属性对比
用 Cells 定位单个单元格
Sub UsingCells()
Dim rng As Range
Dim row As Integer, col As Integer
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets(1)
For row = 1 To 10
For col = 1 To 10
Set rng = ws.Cells(row, col)
rng.Value = rng.Address
Next
Next
Set rng = Nothing
Set ws = Nothing
End Sub
用 Range 定义区域并批量操作
Sub UsingRange()
Dim ws As Worksheet
Dim rng As Range
Set ws = ThisWorkbook.Worksheets(1)
' 使用 Cells 构造区域:A1 到 J10
Set rng = ws.Range(ws.Cells(1, 1), ws.Cells(10, 10))
rng.Value = 1
' 设置特定区域为加粗
Set rng = ws.Range("D4", "E5")
rng.Font.Bold = True
' 设置对齐方式
ws.Range("A1:B2").HorizontalAlignment = xlLeft
Set rng = Nothing
Set ws = Nothing
End Sub
注:
ws.Range(ws.Cells(1, 1), ws.Cells(10, 10))通过两个对角点确定范围,适合动态构建区域。
8.1.2 命名区域的使用注意事项
命名区域分为两种:
- 工作簿级名称:在整个文件中必须唯一。
- 工作表级名称:仅需在所在工作表内唯一。
查看所有命名区域
Sub ListWorkbookNames(wb As Workbook, outputStart As Range)
Dim nm As Name
Dim rowOffset As Long
For Each nm In wb.Names
outputStart.Value = nm.Name
outputStart.Offset(0, 1).Value = "'" & nm.RefersTo
outputStart.Offset(0, 2).Value = "'" & nm.Value
outputStart.Offset(0, 3).Value = nm.RefersToRange
Set outputStart = outputStart.Offset(1, 0)
Next
End Sub
可通过
ThisWorkbook.Worksheets("Sheet2").Range("Testing")引用特定工作表中的命名区域。 但不能从其他工作表直接引用该名称,除非明确指定工作表。
安全验证命名区域是否存在
Function RangeNameExists(ws As Worksheet, name As String) As Boolean
On Error Resume Next
RangeNameExists = Not (ws.Range(name) Is Nothing)
If Err.Number <> 0 Then RangeNameExists = False
Err.Clear
End Function
Sub ValidateNamedRangeExample()
If RangeNameExists(ThisWorkbook.Worksheets(1), "Test") Then
MsgBox "名称存在,指向:" & ThisWorkbook.Names("Test").RefersTo
Else
MsgBox "名称不存在"
End If
End Sub
8.2 区域导航与定位技术
8.2.1 Offset 实现相对移动
利用 Offset 可以逐行遍历数据列表,实现条件筛选。
Sub FilterYear(nYear As Integer)
Dim cell As Range
Dim mileageOffset As Integer
Set cell = ThisWorkbook.Worksheets("List Example").Range("A2")
mileageOffset = 6
Do Until IsEmpty(cell)
If cell.Value < nYear Then
cell.EntireRow.Hidden = True
Else
With cell.Offset(0, mileageOffset)
If .Value < 40000 Then
.Font.Bold = True
Else
.Font.Bold = False
End If
End With
cell.EntireRow.Hidden = False
End If
Set cell = cell.Offset(1, 0)
Loop
Set cell = Nothing
End Sub
8.2.2 End 属性:快速定位边界单元格
End 属性模拟 Ctrl+方向键行为,可快速找到连续数据的末端。
Sub ExperimentWithEnd()
Dim ws As Worksheet
Dim rng As Range
Set ws = ThisWorkbook.Worksheets(1)
Set rng = ws.Cells(1, 1)
ws.Cells(1, 8).Value = "起始位置:" & rng.Address
ws.Cells(2, 8).Value = "向下终点:" & rng.End(xlDown).Address
ws.Cells(3, 8).Value = "继续下移后:" & rng.End(xlDown).End(xlDown).Address
ws.Cells(4, 8).Value = "向右终点:" & rng.End(xlToRight).Address
Set rng = Nothing
Set ws = Nothing
End Sub
获取列中最后一个非空单元格
Function GetLastCellInColumn(rng As Range) As Range
Dim maxRows As Long
maxRows = ThisWorkbook.Worksheets(1).Rows.Count
If IsEmpty(rng.Parent.Cells(maxRows, rng.Column)) Then
Set GetLastCellInColumn = rng.Parent.Cells(maxRows, rng.Column).End(xlUp)
Else
Set GetLastCellInColumn = rng.Parent.Cells(maxRows, rng.Column)
End If
End Function
获取行中最后一个非空单元格位置(返回数值)
Function GetLastUsedRow(rng As Range) As Long
Dim maxRows As Long
maxRows = ThisWorkbook.Worksheets(1).Rows.Count
If IsEmpty(rng.Parent.Cells(maxRows, rng.Column)) Then
GetLastUsedRow = rng.Parent.Cells(maxRows, rng.Column).End(xlUp).Row
Else
GetLastUsedRow = rng.Parent.Cells(maxRows, rng.Column).Row
End If
End Function
Function GetLastUsedColumn(rng As Range) As Long
Dim maxCols As Long
maxCols = ThisWorkbook.Worksheets(1).Columns.Count
If IsEmpty(rng.Parent.Cells(rng.Row, maxCols)) Then
GetLastUsedColumn = rng.Parent.Cells(rng.Row, maxCols).End(xlToLeft).Column
Else
GetLastUsedColumn = rng.Parent.Cells(rng.Row, maxCols).Column
End If
End Function
8.3 灵活的数据输入输出设计
8.3.1 提升代码可维护性的输出策略
避免硬编码引用,改用命名区域提升灵活性。
错误示范:紧耦合格式设置
Sub RigidFormattingProcedure()
ThisWorkbook.Worksheets("Test Report").Activate
ActiveSheet.Range("A:A").Font.Bold = True
ActiveSheet.Range("A:A").EntireColumn.AutoFit
ActiveSheet.Range("A2").NumberFormat = "mmm-yy"
ActiveSheet.Range("6:6").Font.Bold = True
ActiveSheet.Range("N7:N15").Formula = "=sum(rc[-12]:rc[-1])"
ActiveSheet.Range("B16:N16").Formula = "=sum(r[-9]c:r[-1]c)"
ActiveSheet.Range("B7:N16").NumberFormat = "#,##0"
End Sub
改进方案:基于命名区域操作
Sub FlexibleReportFormatter()
Dim ws As Worksheet
If Not WorksheetExists(ThisWorkbook, "Test Report") Then Exit Sub
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 安全接收工作表输入
提供容错机制处理无效数据。
Function ReadCurrencyCell(rng As Range) As Currency
Dim result As Currency
result = 0
On Error GoTo ErrorHandler
If IsEmpty(rng) Then Exit Function
If Not IsNumeric(rng) Then Exit Function
result = rng.Value
Exit Function
ErrorHandler:
ReadCurrencyCell = 0
End Function