最近更新:'2019-04-28'
1.快速找到表格中最后一行数据
2.快速处理大量单元格
3.编写类似Sum(A3:B5)的公式
4.快速处理Range的定位与变形
5.Rows/Columns/MergeCells相关属性
6.Select/宏优化
主要内容介绍:
1.Range位置和大小的属性, UsedRange用法
2.多维数组, Range与数组的映射
3.使用Range做参数；与公式相关的属性
4.与Range形状变换有关的各种属性方法
5.Rows/Columns/MergeCells/Select/宏优化
1.快速找到表格中最后一行数据
1.1怎样得到一个 Range在表格中的位置
1.1.1 Range.Row和Range.Column
返回单元格的行和列
案例1
返回b3:d5范围的行和列
Option Explicit
Sub RangeDemo()
Dim r As Range
Set r = Range("b3:d5")
r.Select
MsgBox r.Row & "行" & r.Column & "列"
End Sub
代码显示的结果如下:
1.1.2 Range.Address
返回单元格的地址
案例1
返回选中单元格的地址
Option Explicit
Sub RangeDemo()
Dim r As Range
Set r = Range("b3:d5")
r.Select
MsgBox r.Address
End Sub
代码显示的结果如下:
1.2怎样了解一个 Range覆盖的范围和大小
1.2.1 Rang.Count
计算选中的Rang的数量
案例1
计算选中的b3:d5的数量
Option Explicit
Sub RangeDemo()
Dim r As Range
Set r = Range("b3:d5")
r.Select
MsgBox r.Count
End Sub
代码显示的结果如下:
注意:
如果选中的单元格区域不规则,则计算的单元格数量会有偏差.
案例2
计算选中"b3:c4", "b4:e4"的数量
Option Explicit
Sub RangeDemo()
Dim r As Range
Set r = Range("b3:c4", "b4:e4")
r.Select
MsgBox r.Count
End Sub
代码显示的结果如下:
1.2.2 Rang.Rows
案例1
选中区域的第1行的所有单元格地址
Sub RowDemo()
Dim a As Range, rw As Range
Set a = Range("c4:e12")
a.Select
Set rw = a.Rows(1)
MsgBox "第1行范围是: " & rw.Address
End Sub
代码显示的结果如下:
案例2
选中区域的第2行的所有单元格地址
Sub RowDemo()
Dim a As Range, rw As Range
Set a = Range("c4:e12")
a.Select
Set rw = a.Rows(2)
MsgBox "第2行范围是: " & rw.Address
End Sub
代码显示的结果如下:
案例3
显示选中单元格区域的行数
Sub RowDemo()
Dim a As Range, rw As Range
Set a = Range("c4:e12")
a.Select
Set rw = a.Rows(1)
MsgBox "一共有" & a.Rows.Count & "行"
End Sub
代码显示的结果如下:
1.2.3 Range.Columns
1.3怎样得到某些特殊的Range对象
以前都是在excel中定义好range的对象,那么在exce中代表l所有的单元格呢?
这个不需要定义,直接在worksheet已经有定义好,用worksheet.cells可以代表excel所有的单元格.
由此可知道excel就是一个大的range的单元格对象.
1.3.1 工作表全部范围所有行总数
对不同版本的excel查找最后一行的方法.
1.3.2 Worksheet.UsedRange
案例1
使用过的单元格的地址
Sub useRangeDemo()
Dim r As Range
Set r = ActiveSheet.UsedRange
r.Select
MsgBox r.Address
End Sub
代码显示的结果如下:
案例2
计算使用区域的最后一行行号
Sub useRangeDemo()
Dim r As Range, i As Long
Set r = ActiveSheet.UsedRange
r.Select
i = r.Row + r.Rows.Count - 1
MsgBox "最后一行是 " & i
End Sub
代码显示的结果如下:
需要注意的地方:
案例3
在第10行的E列增加一个填充的单元格.也是会被认为是usedrange.
2.快速处理大量单元格
首先复习一下之前的二维数组.
2.1工作表转为二维数组
工作表其实也是个二维数组,将工作表转为二维数组也是个非常简单的事情.
将工作表转为二维数组,操作步骤如下:
1.声明一个动态数组a()
2.动态数组等于想引用的对象.
3.动态数组会重新规划与引用数组一样的区域.并将数组对应的数字放到动态数组.动态数组的最小下标是1而非0.
案例1
注意事项如下:
2.2二维数组写入到工作表
案例1
将数组的内容写入到excel中
Sub writeRange()
Dim s(2, 3) As Integer
s(0, 0) = 1: s(0, 1) = 2: s(0, 2) = 3: s(0, 3) = 4
s(1, 0) = 1: s(1, 1) = 2: s(1, 2) = 3: s(1, 3) = 4
s(2, 0) = 1: s(2, 1) = 2: s(2, 2) = 3: s(2, 3) = 4
Range("b2:e4") = s
End Sub
代码显示的结果如下:
注意事项:
3.编写类似Sum(A3:B5)的公式
3.1二维数组的最大下标
案例1
3.2与公式相关的属性
案例1
将工作簿中每个工作簿红色的单元格的扫描并相加在A1单元格的位置.
方法1
Sub demo()
Dim i As Long, j As Long, s As Long
Dim r As Range, w As Worksheet
For Each w In Worksheets
' 将变量s初始化为0,然后用于逐步累加红色数字
s = 0
Set r = w.UsedRange
For i = r.Row To r.Row + r.Rows.Count - 1
For j = r.Column To r.Column + r.Columns.Count - 1
If w.Cells(i, j).Font.Color = vbRed Then
s = s + w.Cells(i, j)
End If
Next j
Next i
' 将累加结果s写入本工作表的A1单元格
w.Cells(1, 1) = s
Next w
End Sub
代码显示的最终结果为
方法2
Sub demo1()
Dim i As Long, j As Long, s As Long
Dim r As Range, w As Worksheet, r1 As Range
For Each w In Worksheets
' 将变量s初始化为0,然后用于逐步累加红色数字
s = 0
Set r = w.UsedRange
For Each r1 In r
If r1.Font.Color = vbRed Then
s = s + r1.Value
End If
Next r1
' 将累加结果s写入本工作表的A1单元格
w.Cells(1, 1) = s
Next w
End Sub
从以下截图可以看出,这个代码程序不够分明.
方法3
可以按照上图的代码将代码分成两个独立的模块,程序互相调用.这样程序结构就比较分明.
Sub demo2()
Dim w As Worksheet
For Each w In Worksheets
w.Cells(1, 1) = redcount(w.UsedRange)
Next w
End Sub
' 本函数接收一个Range类型变量作为参数
' 然后扫描其中每一个单元格,将红色数字汇总返回
Function redcount(r As Range)
Dim s As Long, r1 As Range
For Each r1 In r
If r1.Font.Color = vbRed Then
s = s + r1.Value
End If
Next r1
redcount = s
End Function
自定义函数之后,可以直接在excel运用这个函数
案例2
对数据进行按行求积,再把每行的积加在一起.
方法1
可以使用sumproduct这个函数
方法2
自己写一个函数
Function mySumProduct(r As Range)
'用&代替 as long
Dim i&, j&, s&, k&
s = 0 's用于累计所有乘积之和
For i = r.Row To r.Row + r.Rows.Count - 1
k = 1 'k用于累计每行所有数字的乘积
For j = r.Column To r.Column + r.Columns.Count - 1
k = k * Cells(i, j)
Next j
s = s + k
Next i
mySumProduct = s
End Function
代码显示的最终结果如下:
案例3(Range.hasFormula)
识别出哪个单元格是公式?
'本示例所有公式单元格标记为红色
Sub highlightFormula()
Dim r As Range, r1 As Range
Set r = ActiveSheet.UsedRange
' 扫描r中的每个单元格
For Each r1 In r
'如果该单元格有公式,则设为红色
If r1.HasFormula = True Then
r1.Font.Color = vbRed
End If
Next r1
End Sub
代码显示的最终结果如下:
案例4(Range.Formula)
识别出哪个单元格是公式?并且里面的公式是什么?
如果单元格有公式,则返回公式的字符串
如果单元格没有公式,则返回单元格的数值
案例5(Range.Formula和Range.Value的区别)
将单元格的内容设置为公式
Sub setFormula()
Cells(2, 3).Formula = "=25*2"
Cells(3, 3).Value = "='Sheet4'!C2+10"
End Sub
代码显示的最终结果为
案例6(Range.Value运用)
将单元格的公式替换成运算结果
Sub replaceFormula()
Dim w As Worksheet, r1 As Range
'r1代表每个工作表数据区域中的每个单元格
For Each w In Worksheets
For Each r1 In w.UsedRange
r1.Value = r1.Value
Next r1
Next w
End Sub
将公式替换成运算结果,如下截图:
4.快速处理Range的定位与变形
案例1: range对象的字体变为绿色
方法1
Option Explicit
Sub readCells()
Dim i As Long, j As Long, r As Range
Set r = Range("c4:f6")
For i = r.Row To r.Row + r.Rows.Count - 1
For j = r.Column To r.Column + r.Columns.Count - 1
Cells(i, j).Font.Color = vbGreen
Next j
Next i
End Sub
代码显示的结果如下:
方法2:运用range.cells(i,j)的方法
Option Explicit
Sub readCells()
Dim i As Long, j As Long, r As Range
Set r = Range("c4:f6")
For i = 1 To r.Rows.Count
For j = 1 To r.Columns.Count
r.Cells(i, j).Font.Color = vbGreen
Next j
Next i
End Sub
案例2:Application.Uion
将多个range合为一体,标注为黄色
Sub unionDemo()
Dim r1 As Range, r2 As Range, r3 As Range
Dim ru As Range
Set r1 = Range("b3:e5")
Set r2 = Range("d4:g7")
Set r3 = Range("c5:e9")
Set ru = Union(r1, r2, r3)
ru.Interior.Color = vbYellow
End Sub
代码显示的结果如下:
案例3:Application.Intersect
找到多个range交叉重叠的部分.
Sub unionDemo()
Dim r1 As Range, r2 As Range, r3 As Range
Dim ru As Range
Set r1 = Range("b3:e5")
Set r2 = Range("d4:g7")
Set r3 = Range("c5:e9")
Set ru = Application.Intersect(r1, r2, r3)
ru.Interior.Color = vbYellow
End Sub
代码显示的结果如下:
案例4:Range. CurrentRegion
Range. CurrentRegion需要注意,每个表格之间需要有空白的行列分开.否则默认为是连续使用区.
一个工作表中有若干个表格,每个表格都是独立的.找到上海市这个单元格,然后所在的这张小表格的背景标为蓝色.
Sub regionDemo()
Dim rCity As Range, rTable As Range
For Each rCity In ActiveSheet.UsedRange
If rCity.Value = "上海市" Then
Set rTable = rCity.CurrentRegion
rTable.Interior.Color = RGB(220, 240, 255)
Exit For
End If
Next
End Sub
代码显示最终的结果如下:
案例5:Range.Resize
一个工作表中有若干个表格,每个表格都是独立的.找到上海市这个单元格,然后所在的这张小表格的左上角的2行三列进行染色.
代码显示最终的结果如下:
Sub resizeDemo()
Dim rCity As Range, r1 As Range, r2 As Range
For Each rCity In ActiveSheet.UsedRange
If rCity.Value = "上海市" Then
Set r1 = rCity.CurrentRegion
Set r2 = r1.Resize(2, 3)
r2.Interior.Color = RGB(220, 240, 255)
Exit For
End If
Next
End Sub
注意事项:
案例6:Range.Offset
将指定区域的单元格进行偏移
Sub offsetDemo()
Dim r1 As Range, r2 As Range
Set r1 = Range("c4:f5")
Set r2 = r1.Offset(3, 2)
r2.Interior.Color = vbRed
End Sub
注意事项:
案例7(Range.Offset和Range.Resize以及Range. CurrentRegion)
一个工作表中有若干个表格,每个表格都是独立的.找到上海市这个单元格,然后在指定单元格写上未审核.
Sub demo()
Dim rCity As Range
For Each rCity In ActiveSheet.UsedRange
If rCity.Value = "上海市" Then
rCity.CurrentRegion.Resize(1, 1).Offset(1, 4).Value = "未审核"
Exit For
End If
Next
End Sub
代码显示最终的结果如下:
5.Rows/Columns/MergeCells相关属性
5.1Rows/Columns相关属性
案例1:ActiveSheet.Rows(n)
工作表第8行背景色为黄色
Sub rowDemo()
Dim r As Range
Set r = ActiveSheet.Rows(8)
r.Interior.Color = vbYellow
End Sub
代码显示的最终结果为:
案例2:ActiveSheet.Rows(n)和ActiveSheet.Columns(n)
工作表第8行,第5列背景色为黄色
Sub rowDemo()
Dim r1 As Range, r2 As Range
Set r1 = ActiveSheet.Rows(8)
Set r2 = ActiveSheet.Columns(5)
r1.Interior.Color = vbYellow
r2.Interior.Color = vbYellow
End Sub
代码显示的最终结果为:
案例3:ActiveSheet.Rows("8:12")返回多行
工作表第8行到第12行背景色为黄色
Sub row1Demo()
Dim r As Range
Set r = ActiveSheet.Rows("8:12")
r.Interior.Color = vbYellow
End Sub
代码显示的最终结果为:
案例4:ActiveSheet.Columns("c:e")返回多列
工作表第C列到第E列背景色为黄色
Sub column1Demo()
Dim r As Range
Set r = ActiveSheet.Columns("c:e")
r.Interior.Color = vbYellow
End Sub
5.2合并单元格相关属性
案例1:合并单元格后range相关属性
将d6:e7合并的单元格进行扫描循环.
Sub mergeDemo()
Dim r As Range
'遍历D6：E7范围内的所有单元格
For Each r In Range("d6:e7")
' 将r的地址和内容同时显示，并用冒号隔开
MsgBox r.Address & ":" & r.Value
Next r
End Sub
代码显示的最终结果为:
说明即使是合并单元格之后,VBA还是认为是四个单元格.只有第一个单元格才有数值,而后面三个都是认为是空字符串.
因此可以总结得到以下:
案例2:Range.MergeCells属性
怎么知道range是否包含合并单元格呢?
确定e7:f8区域是否有合并单元格.
Sub mergeTest()
Dim r As Range
Set r = Range("e7:f8")
If r.MergeCells = True Then
MsgBox "该区域完全合并为一个单元格"
ElseIf r.MergeCells = False Then
MsgBox "该区域不包含任何合并单元格"
Else: IsNull (r.MergeCells)
MsgBox "该区域有部分单元格为合并状态"
End If
End Sub
代码最终显示的结果为:
案例3:Range.Merge和Range.Unmerge
对指定的range合并单元格.
方法1
Sub mergeDemo1()
Dim r As Range
Set r = Range("c3:d4")
r.MergeCells = True
End Sub
代码最终显示的结果为:
方法2
Sub mergeDemo1()
Dim r As Range
Set r = Range("c3:d4")
r.Merge
End Sub
案例4
对指定的已合并的range解除合并.
Sub mergeDemo1()
Dim r As Range
Set r = Range("c3:d4")
r.MergeCells = False
End Sub
代码最终显示的结果为:
案例5
将b2:d4的range区域按行合并.
Sub mergeDemo1()
Dim r As Range
Set r = Range("b2:d4")
r.Merge True
End Sub
代码最终显示的结果为:
6.Select/宏优化
6.1Select和Selection相关属性
案例1
select 是选中range.
而selection是指向被选中的的单元格区域
Sub selectionDemo()
Dim r As Range, r1 As Range
' 让r指向当前正被选中的单元格区域
Set r = Selection
' 扫描r中每个单元格,如果小于500就设为红色
For Each r1 In r
If r1.Value < 400 Then
r1.Font.Color = vbRed
End If
Next r1
End Sub
代码最终显示的结果为:
6.2怎样优化宏代码
录制一段宏,将单元格设置为黄色背景,红色粗体字体.
6.3优化宏代码总结:
1.尽可能合并不必要的Select与 Selection
2.尽可能删除不必要的对象属性设置
3.尽可能减少对象中点号的数量（深度）