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

前面两篇博客，我们介绍了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 IfEnd 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 IfEnd 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 IfEnd 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 IfEnd 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 IfEnd With

最后展示下整体效果。