ExcelVBA实例教程#051：不打开工作簿取得其他工作簿数据.doc

在Excel的使用过程中，经常需要引用其他工作簿的数据，而用户往往希望能在不打开工作簿或看似不打开工作簿的情况下取得其他工作簿中的数据，有以下几种方法可以实现。1、使用公式如果需要引用的数据不是太多，可以使用公式取得引用工作簿中的工作表数据，如下面的代码所示。1. Sub CopyData_1()2. Dim Temp As String3. Temp = ThisWorkbook.Path 数据表.xlsSheet1!4. With Sheet1.Range(A1:F22)5. .FormulaR1C1 = = Temp RC6. .Value = .Value7. End With8. End Sub代码解析：CopyData_1过程在工作表中写入公式引用“数据表”中同一位置单元格中的数据。第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 = ThisWorkbook.Path 数据表.xls6. Set Wb = GetObject(Temp)7. With Wb.Sheets(1).Range(A1).CurrentRegion8. Range(A1).Resize(.Rows.Count, .Columns.Count) = .Value9. Wb.Close False10. End With11. Set Wb = Nothing12. Application.ScreenUpdating = True13. End Sub代码解析：CopyData_2过程使用GetObject函数来获取“数据表”工作簿中的数据。第4行代码关闭屏幕更新加快运行速度。第5行代码将引用工作簿的路径赋给变量Temp。第6行代码使用Set语句将GetObject函数返回的对象赋给对象变量Wb。GetObject函数返回文件中的ActiveX对象的引用，语法如下：GetObject(pathname , class)参数pathname是可选的，包含待检索对象的文件的全路径和名称。如果省略，则class参数是必需的。参数class是可选的，代表该对象的类的字符串。Class参数的格式为appname.objecttype，语法的各个部分如表格 1所示。部分描述appname必需的，提供该对象的应用程序名称。objecttype必需的，待创建对象的类型或类。表格 1 Class参数语法的各个部分第7行到第10行代码，当GetObject函数指定的对象被激活之后，就可以在代码中使用对象变量Wb来访问这个对象的属性和方法。其中第7、8行代码将“数据表”工作簿中的第1张工作表已使用区域的数据赋给本工作表的单元格，第9行代码关闭“数据表”工作簿，使用GetObject函数返回对象的引用时，虽然在窗口中看不到对象的实例，但实际上是打开的，所以需用Close语句将其关闭。第12行代码开启屏幕更新。3、隐藏Application对象通过隐藏Application对象来模拟不打开工作簿取数，如下面的代码所示。1. Sub CopyData_3()2. Dim myApp As New Application3. Dim Sh As Worksheet4. Dim Temp As String5. Temp = ThisWorkbook.Path 数据表.xls6. myApp.Visible = False7. Set Sh = myApp.Workbooks.Open(Temp).Sheets(1)8. With Sh.Range(A1).CurrentRegion9. Range(A1).Resize(.Rows.Count, .Columns.Count) = .Value10. End With11. myApp.Quit12. Set Sh = Nothing13. Set myApp = Nothing14. 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方法可以做到不打开工作簿的情况下获取其他工作薄中指定工作表的数据，如下面的代码所示。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. Dim C As Long10. Dim arr() As Variant11. Temp = ThisWorkbook.Path 数据表.xlsSheet1!12. Temp1 = Temp Rows(1).Address(, , xlR1C1)13. Temp1 = Counta( Temp1 )14. CCount = Application.ExecuteExcel4Macro(Temp1)15. Temp2 = Temp Columns(A).Address(, , xlR1C1)16. Temp2 = Counta( Temp2 )17. RCount = Application.ExecuteExcel4Macro(Temp2)18. 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. arr(R, C) = Application.ExecuteExcel4Macro(Temp3)23. Next24. Next25. Range(A1).Resize(RCount, CCount).Value = arr26. End Sub代码解析：CopyData_4过程使用ExecuteExcel4Macro方法获取“数据表”工作薄中指定工作表的数据。第14、16行代码使用ExecuteExcel4Macro方法执行Counta函数取得“数据表”工作薄中指定工作表的行数和列数合计。ExecuteExcel4Macro方法执行一个Microsoft Excel 4.0宏函数，然后返回此函数的结果，语法如下：expression.ExecuteExcel4Macro(String)参数expression是可选的，返回一个Application对象。参数String是必需的，一个不带等号的Microsoft Excel 4.0宏语言函数，所有引用必须是像R1C1这样的字符串。因为Microsoft Excel 4.0 宏不在当前工作簿或工作表的环境中求值，所有的引用都是外部引用，所以无需打开引用工作簿但是需要明确指定工作簿名称。第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. Dim Cnn As ADODB.Connection6. Dim rs As ADODB.Recordset7. With Sheet58. .Cells.Clear9. Set Cnn = New ADODB.Connection10. With Cnn11. .Provider = microsoft.jet.oledb.4.012. .ConnectionString = Extended Properties=Excel 8.0; _13. Data Source= ThisWorkbook.Path 数据表14. .Open15. End With16. Set rs = New ADODB.Recordset17. Sql = select * from Sheet1$18. rs.Open Sql, Cnn, adOpenKeyset, adLockOptimistic19. For j = 0 To rs.Fields.Count - 120. .Cells(1, j + 1) = rs.Fields(j).Name21. Next22. R = .Range(A65536).End(xlUp).Row23. .Range(A R + 1).CopyFromRecordset rs24. End With25. rs.Close26. Cnn.Close27. Set r