Excel VBA 批量提取信息

        有这样一个例子，一个工作簿内有多个部门（每个工作表一个部门）的临时工工资发放表，格式大致如下，每个部门使用了多个区域，且每个部门的姓名、分身证号所在列是不确定的（不同部门造表不同），现在需要提取每个部门的员工姓名，身份证信息。

        经过一番观察，姓名和身份证所在的列虽然不确定，但是标题都十分统一，因此可以使用Find方法查找标题单元格，确定两个列号。另外凡是有姓名区域，A列都是数字序号，可以用Isnumeric函数来判断，排除其他信息。

执行结果

Sub 提取部门姓名身份证()

    Dim NameCol As Long    '姓名所在列的列号

    Dim IdCol As Long    '身份证所在列的列号

    Dim FindRng As Range    '查找单元格对象

    Dim OneSht As Worksheet    '工作表对象

    Dim EndRow As Long    '结束行号

    For Each OneSht In ThisWorkbook.Worksheets

        '>>开始循环每一张工作表

        If Not OneSht.Name Like '*汇总*' Then    '>>排除汇总表

            With OneSht    '>>对工作表进行操作

                NameCol = 0

                IdCol = 0

                '>>部分匹配查找“姓名”第一次出现的单元格

                Set FindRng = .Cells.Find(What:='姓', Lookat:=xlPart)

                '>>如果能找到姓名，记下列号

                If Not FindRng Is Nothing Then NameCol = FindRng.Column

                '>>部分匹配查找“身份证”第一次出现的单元格

                Set FindRng = .Cells.Find(What:='身', Lookat:=xlPart)

                '>>如果能找到身份证，记下列号

                If Not FindRng Is Nothing Then IdCol = FindRng.Column

                '>>用Find方法找出最大行号

                EndRow = .Cells.Find('*', .Cells(1, 1), xlValues, xlWhole, xlByRows, xlPrevious).Row

                '>>开始循环每一行

                For i = 1 To EndRow

                    If .Cells(i, 1).Value <> '' Then    '当A列不为空时

                        If IsNumeric(.Cells(i, 1).Value) Then    '当A列为数字时

                            '>>输出部门，姓名，身份证号

                            Debug.Print '>>>>>>>>>'

                            Debug.Print '部门：'; .Name

                            Debug.Print '姓名：'; .Cells(i, NameCol).Value

                            Debug.Print '身份证：'; .Cells(i, IdCol).Value

                        End If

                    End If

                Next i

            End With

        End If

    Next OneSht

    Set FindRng = Nothing    '释放对象

End Sub