从上一篇《PYTHON操作EXCEL》可以看到,Python 操作 Excel 已非常自如方便。但是 Python 和相关库毕竟是一个额外的依赖,若能从 Excel 自身解决此类问题,自然是更为易用。
1. VBA 中的哈希表
用 Python 的着眼点主要是 VLOOKUP 公式太慢了,所以关键是要找到一种更高效的算法或数据结构定位数据。VLOOKUP 要求对列进行排序,内部应该是对列内数据进行二分查找,算法上不好再优化了,那就只好更换一种数据结构。搜索了一下,VBA 提供了 Scripting.Dictionary 这一词典结构,而且有文章说内部是哈希表实现,那就正是我要的东西了。
这样,VLOOKUP(lookup_value,table_array,col_index_num,range_lookup) 这一公式就转为下面的词典查找方式来实现:
-
使用要从中进行查找的 table_array 内容构建词典。用 table_array 第一列作为 key,table_array 第 col_index_num 列作为 value,插入 Dictionary 中:Dictionary.Add key, value;
-
查找时只需直接取 Dictionary 内的值 Dictionary.Item(lookup_value),即可完成查找;
若是仅仅 VLOOKUP 一次,倒也不必费劲先建立起一个词典。但当使用同样 VLOOKUP 公式的单元格很多时(比如几万个),就显得其必要了。因为 Dictionary 只需要建立一次,就可以用 O(1) 的复杂度进行多次查找了。
2. VLOOKUP 慢,主要问题不在算法上
从算法角度,词典查找的确快于二分查找,但优势并不是那么明显。所以在具体执行时,我发现使用词典查找的 VBA 宏运行速度并不比 VLOOKUP 快多少,运行时 Excel 仍然会导致系统假死几个小时。按说如此简单的程序不应该那么慢,问题究竟在哪里呢?
经过一段摸索,我才发现问题的根源所在:
-
VBA 往 Excel 表格中填内容时,会引发表格中已有公式的自动计算,非常耗时;
-
Excel 表格内容更新时,会触发屏幕显示内容的自动刷新,代价也很高;
所以提高 VBA 脚本执行性能的关键点,在于计算时关掉公式自动计算和屏幕刷新,这也是我始料未及的。在 VBA 中实现这两点很容易,但由于 VLOOKUP 本身即是公式,我没能想通直接调用 VLOOKUP 时如何避免这两点带来的性能损失。
3. 示例 VBA 代码
在做了上面提到的两次优化之后,原来 VLOOKUP N 个小时才能完成的任务,只用了 7 秒钟就执行结束了。
下面是我写的一段示例代码。我不熟悉 VBA 语言,只是照葫芦画瓢。代码规范程度相差甚远,但题意应是体现其中了。有心的朋友可以用作参考。
-
Sub 在机器表上生成一级分中心()
-
'
-
' 在机器表上生成一级分中心 Macro
-
'
-
Application.Calculation = xlCalculationManual
-
Application.ScreenUpdating = False
-
-
t0 = Timer
-
' 词典
-
Set map_dict = CreateObject("Scripting.Dictionary")
-
-
' 打开分中心映射表
-
Set map_sheet = Worksheets("分中心映射表")
-
' map_nrows = map_sheet.Range("A:A").End(xlUp).Row
-
' Set my_rows = map_sheet.Range("A2" & map_nrows).Rows
-
Set my_rows = map_sheet.UsedRange.Rows
-
-
' 遍历分中心映射表,获得 分中心 对应的一级分中心,插入词典
-
For Each my_row In my_rows
-
center = my_row.Cells(1, 1).Value
-
city = my_row.Cells(1, 2).Value
-
If Not map_dict.Exists(center) Then
-
map_dict.Add center, city
-
End If
-
Next my_row
-
-
' 打开机器表
-
Set dispatch_sheet = Worksheets("机器表")
-
dispatch_nrows = dispatch_sheet.Range("a99999").End(xlUp).Row
-
Set my_rows = dispatch_sheet.Range("a1:b" & dispatch_nrows).Rows
-
-
' 遍历开通表,通过词典获得 machine_id 对应的一级分中心,插入开通表
-
For Each o_row In my_rows
-
center = o_row.Cells(1, 2).Value
-
o_row.Cells(1, 2).Value = map_dict.Item(center)
-
Next o_row
-
-
MsgBox "在机器表上生成一级分中心。共处理 " & dispatch_nrows & " 条记录,总耗时" & Timer - t0 & "秒。"
-
-
' 销毁建立的词典
-
Set map_dict = Nothing
-
-
' 打开自动计算和屏幕刷新
-
Application.Calculation = xlCalculationAutomatic
-
Application.ScreenUpdating = True
-
'
-
End Sub
最后补充一点:我先实现的词典查找,后发现性能问题根源,所以未能去比较 VLOOKUP 与词典查找两种方式的具体性能差异。我想如果差异可以忍受,那么直接在 VBA 中调用 VLOOKUP 公式或许是一种更为简单的实现。
4. 测试用例
上面的代码如何测试呢?
-
id name:分中心映射表,字典表 nickName id:机器表,待匹配表 匹配后结果:
-
1 a1 b1 1 b1 a1
-
2 a2 b2 2 b2 a2
-
3 a3 b3 3 b3 a3
-
4 a4 b4 4 b4 a4
-
5 a5 b5 5 b5 a5
-
6 a6 b6 6 b6 a6
-
7 a7 b7 7 b7 a7
-
8 a8 b8 8 b8 a8
-
9 a9 b9 9 b9 a9
-
10 a10 b10 10 b10 a10
5. 一些技巧
5.1 获取EXCEL表格中的行数(有效行)和列数
点击(此处)折叠或打开
-
方法1:
-
ActiveSheet.UsedRange.Rows.Count
-
ActiveSheet.UsedRange.Columns.Count
-
缺点:有时可能会比实际数大一些,原因是如果你把最后几行(列)数据清除后(非整行或整列删除),用这个命令仍返回未清除前的值。就是说现在虽然是空的,但是你曾经用过也算你的。
-
-
方法2:
-
ActiveSheet.Range("A65535").End(xlUp).Row
-
ActiveSheet.Range("IV1").End(xlToLeft).Column
-
可以简写为:
-
ActiveSheet.[A65536].End(xlUp).Row
-
ActiveSheet.[IV1].End(xlToLeft).Column
-
缺点:只能计算出一列(行)的最后一个单元格所在的行(列)数。本例是只返回A列最后一个单元格所占的行数。
-
-
方法3:
-
ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
-
ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column
-
缺点:在工作表进行对删除或清除操作时也会变得比实际情况大。
-
-
方法4:
-
ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
-
ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
-
缺点:在工作表进行对删除或清除操作时也会变得比实际情况大。
-
-
方法5:
-
Application.CountA(ActiveSheet.Range("A:A"))
-
Application.CountA(ActiveSheet.Range("1:1"))
-
只能统计一列(行)的实际使用情况,得到的不一定是最后一行(列)的位置。方法2的数值比此方法大时,说明在A列的数据间有空白未填写的单元格。
-
-
方法6:
-
ActiveSheet.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
-
ActiveSheet.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
-
效果同方法2
-
-
方法7:
-
GetSheet(ws).UsedRange.CurrentRegion.Rows.Count
-
经过加工修改已经可以读出来的是有效数据行
5.2 获得大型文本文件的行数
-
Sub RowCnt()
-
Dim Arr, k&
-
-
Open "C:\qsc.txt" For Input As #1
-
Arr = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
-
k = UBound(Arr) + 1
-
Reset
-
MsgBox "此文本总行数为" & k
-
End Sub
6. Refer
[1] Excel 2013 VBA DOC
(v=office.15).aspx
[2] Worksheet对象应用大全(3)-UsedRange属性详解
[3] 如何获得大型文本文件的行数
阅读(6099) | 评论(0) | 转发(1) |