抓取并汇总多个excel文档内的特定单元格数据？

badbatz

目标：假设我有500个员工的个人信息表，每张信息表的格式是一样的。我需要把每位员工的家庭成员姓名抓取到一个excel文档中（汇总表），请问我应该怎么编程？具体文件已经发在附件中，请高手帮忙。

xiangbaoan

Sub test()
  Dim Cn As Object, Rs As Object, p$, f$, Sq$, s$
  Dim ar$(1 To 2345, 1 To 13), br, i&, j&, k&
  Application.ScreenUpdating = False
  Set Cn = CreateObject("ADODB.Connection")
  If Application.Version < 12 Then
    Cn.Open "Provider=Microsoft.JET.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & ThisWorkbook.FullName
    s = "Excel 8.0;HDR=no;Database="
  Else
    Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
    s = "Excel 12.0;HDR=no;Database="
  End If
  p = ThisWorkbook.Path & "\"
  f = Dir(p & "*.xls?")
  While Len(f)
    If f <> ThisWorkbook.Name Then
      i = i + 1: k = 1
      ar(i, k) = Split(f, ".xls")(0)
      Sq = "SELECT f1 FROM [" & s & p & f & "].[$N12:n24]"
      br = Cn.Execute(Sq).GetRows()
      For j = 0 To UBound(br, 2)
        If Not IsNull(br(0, j)) Then
          k = k + 1
          ar(i, k) = br(0, j)
        End If
      Next
    End If
    f = Dir
  Wend
  Range("A2").Resize(UBound(ar), UBound(ar, 2)) = ar
  Cn.Close: Set Cn = Nothing
  Application.ScreenUpdating = True
  Beep
End Sub

xiangbaoan

test（抓取excel表格信息）2.rar (45.47 KB, 下载次数: 14)

2021-8-17 18:07 上传

点击文件名下载附件

A1233515

附件供参考

badbatz

A1233515 发表于 2021-8-17 18:09
附件供参考

非常感谢！

badbatz

xiangbaoan 发表于 2021-8-17 18:07

非常感谢！