表头(单元格)查找与定位

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            多功能混用