版权声明:本文为博主原创文章,未经博主允许不得转载。 https://blog.csdn.net/DaiHaoC83E15/article/details/50733583
1 Excel的查找功能
VBA中应用于Range对象的Find方法,实际上就是Excel中”Ctrl+F”出来的查找窗口。这个查找功能有一个bug(应该是“参数After+合并单元格”的设计缺陷引发的),以在Excel中查找为例,如下图:
故为了在VBA中对Range使用Find方法的鲁棒性,自己封装个类Find方法后开发程序会更方便,简化定位单元格时需要书写的代码量。
不过,开发这一系列的函数,更主要的原因是解决一些常见麻烦:单元格查找,其实大部分时候都是应用于表头查找,而表头查找会有个多级表头问题。在处理多工作表数据时,还时常会遇到逻辑上是一样的字段,但名称有差异(如”身份证”、”身份证号码”),给数据自动汇总带来不便。
对bug的修复,只需加个if语句。而对于常见麻烦,我采用了一些特殊的设计理念来解决,详见函数的使用方法。由于功能本身带有一定模糊性,实际工作中,遇到比较复杂的表格时,最好检查下函数定位的位置是否正确(笔者也正在思考如何制作小工具进行高效快速检查)。
2 VBA查找功能开发
接口主要是findcel,findrow,findcol三个函数,它们依次返回的是要查找的单元格本身,单元格所在行,单元格所在列。找不到时findcel返回Nothing,findrow和findcol则返回0。
输入参数的规则是一样的:第1个参数st是要查找的工作表,第2个参数name是要查找的值,函数会优先按照“单元格匹配”的规则进行查找,找不到的情况下,会去掉“单元格匹配”再进行查找。
'代码更新于2015年07月30日
Function findcol(ByVal st As Worksheet, ByVal name As String, Optional ByVal partName As String) As Long
Dim t As Range
Set t = findcel(st, name, partName)
If t Is Nothing Then
findcol = 0
Else
findcol = t.Column
End If
End Function
Function findrow(ByVal st As Worksheet, ByVal name As String, Optional ByVal partName As String) As Long
Dim t As Range
Set t = findcel(st, name, partName)
If t Is Nothing Then
findrow = 0
Else
findrow = t.Row
End If
End Function
'该函数支持name、partName用分号隔开,允许按优先级进行字段名搜索的多字段查询
Function findcel(ByVal st As Worksheet, ByVal name As String, Optional ByVal partName As String) As Range
'(1)首先name绝对不能为空
If name = "" Then Exit Function
Dim arr1, arr2
'(2)partName可以为空,但为了后续遍历统一处理,需要先预分析下
arr1 = Split(partName, ";")
If isEmptyArr(arr1) Then
ReDim arr1(1 To 1)
arr1(1) = ""
End If
'(3)开始循环遍历,只要找到第一组满足解即可
arr2 = Split(name, ";")
For Each a1 In arr1
For Each A2 In arr2
Set findcel = findcel_base(st, A2, a1)
If Not (findcel Is Nothing) Then Exit Function
Next A2
Next a1
End Function
Function findcel_base(ByVal st As Worksheet, ByVal name As String, Optional ByVal partName As String) As Range
Dim rng As Range '查找的范围
Set rng = st.UsedRange
'Debug.Print "findcel_base查找内容所在工作薄", st.Parent.name
Dim rng2 As Range, t As Range
'(1)先定位高级表头的列范围
If partName <> "" Then
Set t = rng.Find(partName, LookAt:=xlPart)
'如果第一个是合并单元格,有时候会有找不到的bug
If rng.Cells(1, 1) = partName Then Set t = rng.Cells(1, 1)
'如果确实找不到,退出函数
If t Is Nothing Then Exit Function
'否则就是找到了,计算出找到的(合并)单元格所在列
Set rng2 = st.Range(rng.Cells(1, t.Column), rng.Cells(st.Rows.Count, t.Offset(0, 1).Column - 1))
Set rng = Intersect(rng, rng2) 'Range的交
End If
'(2)然后就可以直接在rng搜索表头名了
Set t = rng.Find(name, LookAt:=xlWhole) '能单元格匹配找到,则按照单元格结果
If t Is Nothing Then Set t = rng.Find(name, LookAt:=xlPart) '否则进行部分查找
If name = rng.Cells(1, 1) Then Set t = rng.Cells(1, 1)
'If Not (t Is Nothing) Then Debug.Print name & "在" & t.Address
Set findcel_base = t
End Function
Private Function isEmptyArr(arr) As Boolean '
isEmptyArr = True
For Each a In arr
isEmptyArr = False
Exit For
Next a
End Function
3 使用举例
测试代码:
Sub 表头查找与定位()
Dim st As Worksheet
Set st = ActiveSheet
'(1)可以用"格式比较稳定"的字段来定位表头所在行
Dim p As Range
Set p = findcel(st, "物理站址编号")
Debug.Print "表头行范围:", p.Row & "~" & (p.Offset(1, 0).Row - 1)
'(2)定位几个字段的位置
Debug.Print "基本定位功能:"
Debug.Print findcol(st, "序号"), "序号"
Debug.Print findcol(st, "面积"), "机房面积(平方米)" '模糊匹配
Debug.Print findcol(st, "资产名称"), "有多个满足时,返回第1个匹配结果"
Debug.Print findcol(st, "账面净额"), "账面净额R-S-T"
Debug.Print findcol(st, "设备类型"), "找不到时返回0值"
Debug.Print "高级定位功能:"
Debug.Print findcol(st, "设备名称;资产名称"), "找不到设备名称后,继续找资产名称"
Debug.Print findcol(st, "原值", "评估价值2"), "多级表头查找与定位"
Debug.Print findcol(st, "总值;价值;原值;净值", "评估值;评估价值"), "多功能混用"
End Sub
处理对象:
立即窗口输出的结果:
表头行范围: 1~2
基本定位功能:
1 序号
5 机房面积(平方米)
4 有多个满足时,返回第1个匹配结果
6 账面净额R-S-T
0 找不到时返回0值
高级定位功能:
4 找不到设备名称后,继续找资产名称
12 多级表头查找与定位
9 多功能混用