使用VBA从海量Excel文件中模糊获取数据并生成新表（附实例） - （三） VBA模糊查找数据

前面两篇博客，我们介绍了VBA和使用VBA获取当前工作表和另一个工作簿的工作表中的数据。这篇我们来说说如何使用VBA模糊查找当前工作表中有用的数据。

我们有时会遇到这样的情况。我们手头有很多很多老的excel文件，他们都是关于提供的内容是类似的，但是他们的格式还有不同，因为表格的样式调整过，或是从别的地方复制过来的，导致格式不尽相同。但值得庆幸的是，你所要的数据在表格中的大致位置是可以确定的。

现在的任务是：把大量类似的excel文件进行整理，从中提取若干字段的值，并汇总到一个新的excel表格中。

比如挑选两种原始文件中的数据：

A类表格：



B类表格：



我们如何使用VBA批量从文件获取“姓名”、“性别”、“出生日期”和“年龄等呢？

处理实际任务时，可能会有很多种表格格式需要兼容。这里为了方便演示，我举出如下几个场景。

1. 字段名和字段值位于前后两个单元格中

字段名和字段值分开的情况，一般都是字段值在字段名的邻近靠后的单元格，类似上图中的姓名。

查找思路：

1. 确认可能出现的区域

2. 在区域内查找包含字段名的单元格

3. 获取字段名单元格水平后面的单元格

4. 获取字段值

示例代码：

'姓名字段名出现的范围是：A3到A5的区域内
With sheet.Range("A3:A5")
'查找包含“姓名”的单元格
Set c = .Find("姓名", LookIn:=xlValues)
'如果找到
If Not c Is Nothing Then
'获取匹配单元格水平后面一个单元格的内容
PName = sheet.Cells(c.Row, c.Column + 1).Value
End If
End With

2. 字段名和字段值在一个单元格中

对于字段名和字段值在一个单元格中的情况，则需要把字段名和间隔符去掉，留下的值视为字段值

查找思路：

1. 确认可能出现的区域

2. 在区域内查找包含字段名的单元格

3. 去除字段名和间隔符

4. 获取字段值

示例代码：

'姓名字段名出现的范围是：A3到A5的区域内
With sheet.Range("A3:A5")
'查找包含“姓名”的单元格
Set c = .Find("姓名", LookIn:=xlValues)
'如果找到
If Not c Is Nothing Then
'获取第一个匹配的单元格的内容
PName = c.Value
'去除字段名“姓名”
If Mid(PName, 1, 2) = "姓名" Then PName = Mid(PName, 3, Len(PName))
'去除分隔符“:”（英文分隔符）和“：”（中文分隔符）
If Mid(PName, 1, 1) = ":" Then PName = Mid(PName, 2, Len(PName))
If Mid(PName, 1, 1) = "：" Then PName = Mid(PName, 2, Len(PName))
End If
End With

3. 混合1和2两种情况

对于有的字段（比如：性别）出现了上述两种情况，则程序需要同时兼容。

查找思路：

1. 确认可能出现的区域

2. 在区域内查找包含字段名的单元格

3. 去除字段名和间隔符，判断剩下的值是否为空

4. 如果为空，则获取单元格水平后面的单元格的内容

示例代码：

'性别字段名出现的范围是：E3到G4的区域内
With sheet.Range("E3:G4")
'查找包含“性别”的单元格
Set c = .Find("性别", LookIn:=xlValues)
'如果找到
If Not c Is Nothing Then
'获取第一个匹配的单元格的内容
PName = c.Value
'去除字段名“性别”
If Mid(PName, 1, 2) = "性别" Then PName = Mid(PName, 3, Len(PName))
'去除分隔符“:”（英文分隔符）和“：”（中文分隔符）
If Mid(PName, 1, 1) = ":" Then PName = Mid(PName, 2, Len(PName))
If Mid(PName, 1, 1) = "：" Then PName = Mid(PName, 2, Len(PName))

If PName = "" Then
'获取匹配单元格水平后面一个单元格的内容
PName = sheet.Cells(c.Row, c.Column + 1).Value
End If
End If
End With

4. 无字段名， 仅有字段值

对于没有字段名的情况，获取字段值可能会比较麻烦一些。这要看字段值是否有一定规律。比如“出生日期”，是日期格式，获取还是相对比较容易的。又或者是有固定几个枚举值的字段，比如“性别”。

查找思路：

1. 确认可能出现的区域

2. 在区域内查找符合某一规律的一个或多个单元格

3. 如果确认完全满足字段值的要求，则获取成功

4. 否则继续校验其他符合规律的单元格

示例代码：

'出生日期字段名出现的范围是：C3到E4的区域内
With sheet.Range("C3:E4")
'查找包含“19”的单元格
Set c = .Find("19", LookIn:=xlValues)
'如果找到
If Not c Is Nothing Then
'保存第一个匹配的单元格地址,用于循环判断（因为FindNext方法找到最后一个匹配后，还可以跳到第一个匹配的单元格）
cAddress = c.Address

Do
'获取匹配的单元格的内容
PBirthDay = c.Value

'精确匹配：如果字段值的长度小于8个字符，或者第五个字符不是斜杠“/”、连接符“-”或反斜杠“/”中的一个，则匹配失败
If Len(PBirthDay) < 8 Or Not (Mid(PBirthDay, 5, 1) = "/" Or Mid(PBirthDay, 5, 1) = "-" Or Mid(PBirthDay, 5, 1) = "\") Then
PBirthDay = ""
End If

'查找下一个匹配的单元格
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> cAddress And PBirthDay = ""
End If
End With

5. 混合1、2和4的情况

上面已经分析了1、2和4的情况，我们只要把代码合并到一起，即可能兼容两种情况了。

查找思路：

1. 确认可能出现的区域

2. 在区域内查找符合某一规律的一个或多个单元格

3. 如果确认完全满足字段值的要求，则获取成功

4. 否则继续校验其他符合规律的单元格

5. 如果没有找到符合条件的字段值，则查找字段名

6. 判断字段名的单元格是否包含字段值

6. 如果不包含，获取字段名单元格水平后面的单元格

示例代码：

'出生日期字段名出现的范围是：C3到E4的区域内
With sheet.Range("C3:E4")
'查找包含“19”的单元格
Set c = .Find("19", LookIn:=xlValues)
'如果找到
If Not c Is Nothing Then
'保存第一个匹配的单元格地址,用于循环判断（因为FindNext方法找到最后一个匹配后，还可以跳到第一个匹配的单元格）
cAddress = c.Address

Do
'获取匹配的单元格的内容
PBirthDay = c.Value

'精确匹配：如果字段值的长度小于8个字符，或者第五个字符不是斜杠“/”、连接符“-”或反斜杠“/”中的一个，则匹配失败
If Len(PBirthDay) < 8 Or Not (Mid(PBirthDay, 5, 1) = "/" Or Mid(PBirthDay, 5, 1) = "-" Or Mid(PBirthDay, 5, 1) = "\") Then
PBirthDay = ""
End If

'查找下一个匹配的单元格
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> cAddress And PBirthDay = ""
End If

'忙活了半天，没找到，再试试用字段名查找下吧。。
If PBirthDay = "" Then
'查找包含“出生日期”的单元格
Set c = .Find("出生日期", LookIn:=xlValues)
'如果找到
If Not c Is Nothing Then
'获取匹配单元格水平后面一个单元格的内容
PBirthDay = Trim(c.Value)

'去除字段名和分隔符
If PBirthDay <> "" Then If Mid(PBirthDay, 1, 4) = "出生日期" Then PBirthDay = Mid(PBirthDay, 5, Len(PBirthDay))
If PBirthDay <> "" Then If Mid(PBirthDay, 1, 1) = ":" Then PBirthDay = Mid(PBirthDay, 2, Len(PBirthDay))
If PBirthDay <> "" Then If Mid(PBirthDay, 1, 1) = "：" Then PBirthDay = Mid(PBirthDay, 2, Len(PBirthDay))

'获取匹配单元格水平后面一个单元格的内容
If PBirthDay = "" Then
PBirthDay = sheet.Cells(c.Row, c.Column + 1)
End If
End If
End If
End With

最后展示下整体效果。