不打开工作簿提取数据的几种方法

来源：https://blog.csdn.net/weixin_30333885/article/details/95682316?spm=1001.2101.3001.6650.1&utm_medium=distribute.pc_relevant.none-task-blog-2%7Edefault%7ECTRLIST%7ERate-1.pc_relevant_default&depth_1-utm_source=distribute.pc_relevant.none-task-blog-2%7Edefault%7ECTRLIST%7ERate-1.pc_relevant_default&utm_relevant_index=2
不打开工作簿取得其他工作簿数据的几种方法
在Excel的使用过程中，经常需要引用其他工作簿的数据，而用户往往希望能在不打开工作簿或看似不打开工作簿的情况下取得其他工作簿中的数据，有以下几种方法可以实现。1  数据不多时使用公式
如果需要引用的数据不是太多，可以使用公式取得引用工作簿中的工作表数据，如下面的代码所示。
  Sub CopyData_1()
      Dim Temp As String
      Temp = "'" & ThisWorkbook.Path & "\[数据表.xls]Sheet1'!"  With Sheet1.Range("A1:F22")
          .FormulaR1C1 = "=" & Temp & "RC"  .Value = .Value
      End With
  End Sub
代码解析：
CopyData_1过程在工作表中写入公式引用“数据表”中同一位置单元格中的数据。
第3行代码将引用工作簿的路径赋给变量Temp。
第5行代码在作表中写入公式引用数据。
第6行代码将公式转换为数值。2  使用GetObject函数获取对指定的Excel工作表的引用
使用GetObject函数来获取对指定的Excel工作表的引用，如下面的代码所示。
  Sub CopyData_2()
      Dim Wb As Workbook
      Dim Temp As String
      Application.ScreenUpdating = False
      Temp = ThisWorkbook.Path & "\数据表.xls"  Set Wb = GetObject(Temp)
          With Wb.Sheets(1).Range("A1").CurrentRegion
              Range("A1").Resize(.Rows.Count, .Columns.Count) = .Value
              Wb.Close False
          End With
      Set Wb = Nothing
      Application.ScreenUpdating = True
  End Sub
代码解析：
CopyData_2过程使用GetObject函数来获取“数据表”工作簿中的数据。
第4行代码关闭屏幕更新加快运行速度。
第5行代码将引用工作簿的路径赋给变量Temp。
第6行代码使用Set语句将GetObject函数返回的对象赋给对象变量Wb。
第7行到第10行代码，当GetObject函数指定的对象被激活之后，就可以在代码中使用对象变量Wb来访问这个对象的属性和方法。
其中第7、8行代码将“数据表”工作簿中的第1张工作表已使用区域的数据赋给本工作表的单元格，第9行代码关闭“数据表”工作簿，使用GetObject函数返回对象的引用时，虽然在窗口中看不到对象的实例，但实际上是打开的，所以需用Close语句将其关闭。
第12行代码开启屏幕更新。3  隐藏Application对象来模拟不打开工作簿取数
通过隐藏Application对象来模拟不打开工作簿取数，如下面的代码所示。
  Sub CopyData_3()
      Dim myApp As New Application
      Dim Sh As Worksheet
      Dim Temp As String
      Temp = ThisWorkbook.Path & "\数据表.xls"  myApp.Visible = False
      Set Sh = myApp.Workbooks.Open(Temp).Sheets(1)
      With Sh.Range("A1").CurrentRegion
          Range("A1").Resize(.Rows.Count, .Columns.Count) = .Value
      End With
      myApp.Quit
      Set Sh = Nothing
      Set myApp = Nothing
  End Sub
代码解析：
CopyData_3过程隐藏Application对象来模拟不打开工作簿取数。
第2行代码使用New关键字隐式地创建一个Application对象。
第6行代码将新创建的Application对象的Visible属性设置为False，使之隐藏。
第7行代码使用Open方法打开“数据表”工作簿（关于Open方法请参阅技巧42 ，因为工作簿是使用新创建的、隐藏的Application对象打开的，所以在窗口中是不可视的。
第8行到第10行代码将“数据表”工作簿中的第1张工作表已使用区域的数据赋给本工作表的单元格。
第11行代码使用Quit方法退出新打开的Excel程序。4  使用ExecuteExcel4Macro方法
使用ExecuteExcel4Macro方法可以做到不打开工作簿的情况下获取其他工作薄中指定工作表的数据，如下面的代码所示。
  Sub CopyData_4()
      Dim RCount As Long
      Dim CCount As Long
      Dim Temp As String
      Dim Temp1 As String
      Dim Temp2 As String
      Dim Temp3 As String
      Dim R As Long
      Dim C As Long
      Dim arr() As Variant
      Temp = "'" & ThisWorkbook.Path & "\[数据表.xls]Sheet1'!"  Temp1 = Temp & Rows(1).Address(, , xlR1C1)
      Temp1 = "Counta(" & Temp1 & ")"  CCount = Application.ExecuteExcel4Macro(Temp1)
      Temp2 = Temp & Columns("A").Address(, , xlR1C1)
      Temp2 = "Counta(" & Temp2 & ")"  RCount = Application.ExecuteExcel4Macro(Temp2)
      ReDim arr(1 To RCount, 1 To CCount)
      For R = 1 To RCount
          For C = 1 To CCount
              Temp3 = Temp & Cells(R, C).Address(, , xlR1C1)
              arr(R, C) = Application.ExecuteExcel4Macro(Temp3)
          Next
      Next
      Range("A1").Resize(RCount, CCount).Value = arr
  End Sub
代码解析：
CopyData_4过程使用ExecuteExcel4Macro方法获取“数据表”工作薄中指定工作表的数据。
第14、16行代码使用ExecuteExcel4Macro方法执行Counta函数取得“数据表”工作薄中指定工作表的行数和列数合计。
第18行代码使用ReDim语句为动态数组arr重新分配存储空间。
第19行到第24行代码循环取值，将“数据表”工作薄中指定工作表的数据赋给动态数组arr。
第25行代码将动态数组arr的值赋给工作表的单元格。5  使用SQL连接查询数据记录后复制到当前工作表中
使用SQL建立与工作簿的连接，查询数据记录后复制到当前工作表中，如下面的代码所示。
  Sub CopyData_5()
      Dim Sql As String
      Dim j As Integer
      Dim R As Integer
      Dim Cnn As ADODB.Connection
      Dim rs As ADODB.Recordset
      With Sheet5
          .Cells.Clear
          Set Cnn = New ADODB.Connection
          With Cnn
              .Provider = "microsoft.jet.oledb.4.0"  .ConnectionString = "Extended Properties=Excel 8.0;" _
                  & "Data Source=" & ThisWorkbook.Path & "\数据表"  .Open
          End With
          Set rs = New ADODB.Recordset
          Sql = "select * from [Sheet1$]"  rs.Open Sql, Cnn, adOpenKeyset, adLockOptimistic
              For j = 0 To rs.Fields.Count - 1  .Cells(1, j + 1) = rs.Fields(j).Name
              Next
          R = .Range("A65536").End(xlUp).Row
          .Range("A" & R + 1).CopyFromRecordset rs
      End With
      rs.Close
      Cnn.Close
      Set rs = Nothing
      Set Cnn = Nothing
  End Sub
代码解析：
CopyData_5过程使建立与“数据表”工作簿的连接，查询数据记录后复制到当前工作表中。
第8行代码删除当前工作表的所有数据。
第9行到第15行代码建立与“数据表”工作簿的连接。
第16行到第24行代码查询“数据表”工作簿的全部数据，并复制到工作表中。其中第20行代码将字段名称（标题行）复制到工作表中，第23行代码将查询到的数据记录复制到工作表。