Excel_VBA从关闭的工作簿中取值多种实现方法(代码)

1、从关闭的工作簿中取值有多种方法，现将网上收集的整理向大家共享。方法1、使用公式方法2、使用GetObject函数方法3、隐藏Application对象方法4、使用ExecuteExcel4Macro方法方法5、使用SQL连接其它收集的相关内容1、使用公式如果需要引用的数据不是太多，可以使用公式取得引用工作簿中的工作表数据，如下面的代码所示。1. Sub CopyData_1()2.     Dim Temp As String3.     Temp = "'" & ThisWorkbook.Path & &qu

2、ot;数据表.xlsSheet1'!"4.     With Sheet1.Range("A1:F22")5.         .FormulaR1C1 = "=" & Temp & "RC"6.         .Value = .Value7.     End With8. End Sub代码解析：CopyData_1过程在工作表中写入公式

3、引用“数据表”中同一位置单元格中的数据。第3行代码将引用工作簿的路径赋给变量Temp。第5行代码在作表中写入公式引用数据。第6行代码将公式转换为数值。2、使用GetObject函数 （返回目录）使用GetObject函数来获取对指定的Excel工作表的引用，如下面的代码所示。1. Sub CopyData_2()2.     Dim Wb As Workbook3.     Dim Temp As String4.     Application.ScreenUpdating = False5.     Temp

4、= ThisWorkbook.Path & "数据表.xls"6.     Set Wb = GetObject(Temp)7.         With Wb.Sheets(1).Range("A1").CurrentRegion8.             Range("A1").Resize(.Rows.Count, .Columns.Count) = .Valu

5、e9.             Wb.Close False10.         End With11.     Set Wb = Nothing12.     Application.ScreenUpdating = True13. End Sub代码解析：CopyData_2过程使用GetObject函数来获取“数据表”工作簿中的数据。第4行代码关闭屏幕更新加快运行速度。第5行代码将引用工作簿的路径赋给变量Te

6、mp。第6行代码使用Set语句将GetObject函数返回的对象赋给对象变量Wb。GetObject函数返回文件中的ActiveX对象的引用，语法如下：GetObject(pathname , class)参数pathname是可选的，包含待检索对象的文件的全路径和名称。如果省略，则class参数是必需的。参数class是可选的，代表该对象的类的字符串。Class参数的格式为appname.objecttype，语法的各个部分如表格 1所示。部分描述appname必需的，提供该对象的应用程序名称。objecttype必需的，待创建对象的类型或类。表格 1 Class参数语法的各个部分第7行到第

7、10行代码，当GetObject函数指定的对象被激活之后，就可以在代码中使用对象变量Wb来访问这个对象的属性和方法。其中第7、8行代码将“数据表”工作簿中的第1张工作表已使用区域的数据赋给本工作表的单元格，第9行代码关闭“数据表”工作簿，使用GetObject函数返回对象的引用时，虽然在窗口中看不到对象的实例，但实际上是打开的，所以需用Close语句将其关闭。第12行代码开启屏幕更新。3、隐藏Application对象（返回目录）通过隐藏Application对象来模拟不打开工作簿取数，如下面的代码所示。1. Sub CopyData_3()2.     Dim myApp

8、 As New Application3.     Dim Sh As Worksheet4.     Dim Temp As String5.     Temp = ThisWorkbook.Path & "数据表.xls"6.     myApp.Visible = False7.     Set Sh = myApp.Workbooks.Open(Temp).Sheets(1)8.     With Sh.Range("A1&quo

9、t;).CurrentRegion9.         Range("A1").Resize(.Rows.Count, .Columns.Count) = .Value10.     End With11.     myApp.Quit12.     Set Sh = Nothing13.     Set myApp = Nothing14. End Sub代码解析：CopyData_3过程隐藏Application对象来模拟不打开工作

10、簿取数。第2行代码使用New关键字隐式地创建一个Application对象。第6行代码将新创建的Application对象的Visible属性设置为False，使之隐藏。第7行代码使用Open方法打开“数据表”工作簿（关于Open方法请参阅技巧42 ，因为工作簿是使用新创建的、隐藏的Application对象打开的，所以在窗口中是不可视的。第8行到第10行代码将“数据表”工作簿中的第1张工作表已使用区域的数据赋给本工作表的单元格。第11行代码使用Quit方法退出新打开的Excel程序。4、使用ExecuteExcel4Macro方法（返回目录）使用ExecuteExcel4Macro方法可以做

11、到不打开工作簿的情况下获取其他工作薄中指定工作表的数据，如下面的代码所示。1. Sub CopyData_4()2.     Dim RCount As Long3.     Dim CCount As Long4.     Dim Temp As String5.     Dim Temp1 As String6.     Dim Temp2 As String7.     Dim Temp3 As String8.     Dim R As Long9

12、.     Dim C As Long10.     Dim arr() As Variant11.     Temp = "'" & ThisWorkbook.Path & "数据表.xlsSheet1'!"12.     Temp1 = Temp & Rows(1).Address(, , xlR1C1)13.     Temp1 = "Counta(" & Temp1 & &

13、quot;)"14.     CCount = Application.ExecuteExcel4Macro(Temp1)15.     Temp2 = Temp & Columns("A").Address(, , xlR1C1)16.     Temp2 = "Counta(" & Temp2 & ")"17.     RCount = Application.ExecuteExcel4Macro(Temp2)18.

14、    ReDim arr(1 To RCount, 1 To CCount)19.     For R = 1 To RCount20.         For C = 1 To CCount21.             Temp3 = Temp & Cells(R, C).Address(, , xlR1C1)22.          

15、0;  arr(R, C) = Application.ExecuteExcel4Macro(Temp3)23.         Next24.     Next25.     Range("A1").Resize(RCount, CCount).Value = arr26. End Sub代码解析：CopyData_4过程使用ExecuteExcel4Macro方法获取“数据表”工作薄中指定工作表的数据。第14、16行代码使用ExecuteExcel4Macro方

16、法执行Counta函数取得“数据表”工作薄中指定工作表的行数和列数合计。ExecuteExcel4Macro方法执行一个Microsoft Excel 4.0宏函数，然后返回此函数的结果，语法如下：expression.ExecuteExcel4Macro(String)参数expression是可选的，返回一个Application对象。参数String是必需的，一个不带等号的Microsoft Excel 4.0宏语言函数，所有引用必须是像R1C1这样的字符串。因为Microsoft Excel 4.0 宏不在当前工作簿或工作表的环境中求值，所有的引用都是外部引用，所以无需打开引用工作簿但

17、是需要明确指定工作簿名称。第18行代码使用ReDim语句为动态数组arr重新分配存储空间。第19行到第24行代码循环取值，将“数据表”工作薄中指定工作表的数据赋给动态数组arr。第25行代码将动态数组arr的值赋给工作表的单元格。5、使用SQL连接（返回目录）使用SQL建立与工作簿的连接，查询数据记录后复制到当前工作表中，如下面的代码所示。1. Sub CopyData_5()2.     Dim Sql As String3.     Dim j As Integer4.     Dim R As Integer5.  

18、  Dim Cnn As ADODB.Connection6.     Dim rs As ADODB.Recordset7.     With Sheet58.         .Cells.Clear9.         Set Cnn = New ADODB.Connection10.         With Cnn11.     

19、;        .Provider = "microsoft.jet.oledb.4.0"12.             .ConnectionString = "Extended Properties=Excel 8.0;" _13.                 & "Data Source="

20、; & ThisWorkbook.Path & "数据表"14.             .Open15.         End With16.         Set rs = New ADODB.Recordset17.         Sql = "select * from Shee

21、t1$"18.         rs.Open Sql, Cnn, adOpenKeyset, adLockOptimistic19.             For j = 0 To rs.Fields.Count - 120.                 .Cells(1, j + 1) = rs.Fields(j).Name21.

22、60;           Next22.         R = .Range("A65536").End(xlUp).Row23.         .Range("A" & R + 1).CopyFromRecordset rs24.     End With25.     rs.Close26.   &#

23、160; Cnn.Close27.     Set rs = Nothing28.     Set Cnn = Nothing29. End Sub代码解析：CopyData_5过程使建立与“数据表”工作簿的连接，查询数据记录后复制到当前工作表中。第8行代码删除当前工作表的所有数据。第9行到第15行代码建立与“数据表”工作簿的连接。第16行到第24行代码查询“数据表”工作簿的全部数据，并复制到工作表中。其中第20行代码将字段名称（标题行）复制到工作表中，第23行代码将查询到的数据记录复制到工作表。其它收集的相关内容：（返回目录）示例代码1：Sub tes

24、tGetValuesFromClosedWorkbook() GetValuesFromAClosedWorkbook "C:", "Book1.xls", "Sheet1", "A1:G20"End Sub Sub GetValuesFromAClosedWorkbook(fPath As String, _ fName As String, sName, cellRange As String) With ActiveSheet.Range(cellRange) .FormulaArray = &qu

25、ot;='" & fPath & "" & fName & "" _ & sName & "'!" & cellRange .Value = .Value End WithEnd Sub本示例包含一个子过程GetValuesFromAClosedWorkbook，用来从已关闭的工作簿中获取数据，主过程testGetValuesFromClosedWorkbook用来传递参数。本示例表示从C盘根目录下的Book1.xls工作簿的工作表Sheet1中的A1:

26、G20单元格区域内获取数据，并将其复制到当前工作表相应单元格区域中。示例代码2：已前面的代码相似，下面的VBA代码从关闭的工作簿中获取值。Sub ExtractDataFromClosedWorkBook()  Application.ScreenUpdating = False  '创建链接来从关闭的工作簿中获取数据 '可以将相关代码修改为相应的路径和单元格 With Sheet1!A1:B4 .Value = "='" & ActiveWorkbook.Path & "testDataWorkbook

27、.xlsSheet1'!A1:B4" '删除链接 .Value = .Value End With  Application.ScreenUpdating = True End Sub其中，可以将代码中的路径修改为需要从中获取值的工作簿的路径，单元格也作相应的修改。示例代码3：Sub GetDataFromClosedWorkbook() Dim wb As Workbook Application.ScreenUpdating = False '以只读方式打开工作簿 Set wb = Workbooks.Open("C:文件夹名

28、文件.xls", True, True) With ThisWorkbook.Worksheets("工作表名") '从工作簿中读取数据 .Range("A10").Formula = wb.Worksheets("源工作表名").Range("A10").Formula .Range("A11").Formula = wb.Worksheets("源工作表名").Range("A20").Formula .Range("A12

29、").Formula = wb.Worksheets("源工作表名").Range("A30").Formula .Range("A13").Formula = wb.Worksheets("源工作表名").Range("A40").Formula End With wb.Close False '关闭打开的源数据工作簿且不保存任何变化 Set wb = Nothing '释放内存 Application.ScreenUpdating = TrueEnd Sub在运行程

30、序时，打开所要获取数据的工作簿，当取得数据后再关闭该工作簿。将屏幕更新属性值设置为False，将看不出源数据工作簿是否被打开过。本程序代码中，“C:文件夹名文件.xls”、”源工作表名”代表工作簿所在的文件夹和工作簿文件名。示例代码4：下面是JOHN WALKENBACH先生使用VBA编写的一个实用函数，其作用是从关闭的工作簿中取值。VBA没有包含从关闭的文件中获取值的方法，但是利用Excel处理连接文件的功能，可以实现。该函数要调用XLM宏，但不能在工作表公式中使用该函数。GetValue函数具有四个参数，分别如下：· path: 关闭的文件的驱动器和路径(例如”d:files”)

31、· file: 工作簿名称(例如”99budget.xls”)· sheet: 工作表名称(例如”Sheet1)· ref: 单元格引用(例如”C4)Private Function GetValue(path, file, sheet, ref)' 从一个关闭的工作簿中获取值 Dim arg As String ' 确保该文件存在 If Right(path, 1) <> "" Then path = path & "" If Dir(path & file) = "&

32、quot; Then GetValue = "File Not Found" Exit Function End If' 创建参数 arg = "'" & path & "" & file & "" & sheet & "'!" & _ Range(ref).Range("A1").Address(, , xlR1C1)' 执行XLM宏 GetValue = ExecuteExcel4Ma

33、cro(arg)End Function使用GetValue函数要使用该函数，将其复制到VBA模块中，然后使用合适的参数调用该函数。子过程演示如下，简单地显示在名为99Budget.xls工作簿Sheet1的单元格A1中的值，该文件在驱动器C:中的XLFilesBudget目录下。Sub TestGetValue() p = "c:XLFilesBudget" f = "99Budget.xls" s = "Sheet1" a = "A1" MsgBox GetValue(p, f, s, a)End Sub另一个

34、示例如下，该过程从一个关闭的文件中读取1,200个值(100行和12列)，并将这些值放置到活动工作表中。Sub TestGetValue2() p = "c:XLFilesBudget" f = "99Budget.xls" s = "Sheet1" Application.ScreenUpdating = False For r = 1 To 100 For c = 1 To 12 a = Cells(r, c).Address Cells(r, c) = GetValue(p, f, s, a) Next c Next r App

35、lication.ScreenUpdating = TrueEnd Sub注意：为了使该函数正常运行，在Excel中必须有一个活动工作表。如果所有窗口都是隐藏的，或者活动工作表为图表工作表，那么将产生错误。示例代码5：Sub ReadDataFromAllWorkbooksInFolder() Dim FolderName As String, wbName As String, r As Long, cValue As Variant Dim wbList() As String, wbCount As Integer, i As Integer FolderName = "C:文件夹名" '创