从关闭的工作簿中取值(代码)

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


从关闭的工作簿中取值有多种方法，现将网上收集的整理向大家共享。

方法1、使用公式

方法2、使用GetObject函数

方法3、隐藏Application对象

方法4、使用ExecuteExcel4Macro方法

方法5、使用SQL连接 其它收集的相关内容

1、使用公式

如果需要引用的数据不是太多，可以使用公式取得引用工作簿中的工作表数据，如下面的代码所示。 1. Sub CopyData_1()

2. Dim Temp As String

3. Temp = "'" & ThisWorkbook.Path & "￥[数据表.xls]Sheet1'!"

4. With Sheet1.Range("A1:F22")

5. .FormulaR1C1 = "=" & Temp & "RC"

6. .Value = .Value

7. End With

8. End Sub

代码解析：

CopyData_1过程在工作表中写入公式引用“数据表”中同一位置单元格中的数据。

第3行代码将引用工作簿的路径赋给变量Temp。

第5行代码在作表中写入公式引用数据。

第6行代码将公式转换为数值。

2、使用GetObject函数 （返回目录）

使用GetObject函数来获取对指定的Excel工作表的引用，如下面的代码所示。

1. Sub CopyData_2()

2. Dim Wb As Workbook

3. Dim Temp As String

4. Application.ScreenUpdating = False

5. Temp = ThisWorkbook.Path & "￥数据表.xls"

6. Set Wb = GetObject(Temp)

7. With Wb.Sheets(1).Range("A1").CurrentRegion

8. Range("A1").Resize(.Rows.Count, .Columns.Count) = .Value

9. Wb.Close False

10. End With

11. Set Wb = Nothing

12. Application.ScreenUpdating = True

13. End Sub

代码解析：

CopyData_2过程使用GetObject函数来获取“数据表”工作簿中的数据。

第4行代码关闭屏幕更新加快运行速度。

第5行代码将引用工作簿的路径赋给变量Temp。

第6行代码使用Set语句将GetObject函数返回的对象赋给对象变量Wb。

GetObject函数返回文件中的ActiveX对象的引用，语法如下：

GetObject([pathname] [, class])

参数pathname是可选的，包含待检索对象的文件的全路径和名称。如果省略，则class参数是必需的。

参数class是可选的，代表该对象的类的字符串。

Class参数的格式为appname.objecttype，语法的各个部分如表格 1所示。

表格 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 Application

3. Dim Sh As Worksheet

4. Dim Temp As String

5. Temp = ThisWorkbook.Path & "￥数据表.xls"

6. myApp.Visible = False

7. Set Sh = myApp.Workbooks.Open(Temp).Sheets(1)

8. With Sh.Range("A1").CurrentRegion

9. Range("A1").Resize(.Rows.Count, .Columns.Count) = .Value

10. End With

11. myApp.Quit

12. Set Sh = Nothing

13. Set myApp = Nothing

14. 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 Long

3. Dim CCount As Long

4. Dim Temp As String

5. Dim Temp1 As String

6. Dim Temp2 As String

7. Dim Temp3 As String

8. Dim R As Long

9. Dim C As Long

10. Dim arr() As Variant

11. Temp = "'" & ThisWorkbook.Path & "￥[数据表.xls]Sheet1'!"

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 RCount

20. For C = 1 To CCount

21. Temp3 = Temp & Cells(R, C).Address(, , xlR1C1)

22. arr(R, C) = Application.ExecuteExcel4Macro(Temp3)

23. Next

24. Next

25. Range("A1").Resize(RCount, CCount).Value = arr

26. 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 String

3. Dim j As Integer

4. Dim R As Integer

5. Dim Cnn As ADODB.Connection

6. Dim rs As ADODB.Recordset

7. With Sheet5

8. .Cells.Clear

9. Set Cnn = New ADODB.Connection

10. With Cnn

11. .Provider = "microsoft.jet.oledb.4.0"

12. .ConnectionString = "Extended Properties=Excel 8.0;" _

13. & "Data Source=" & ThisWorkbook.Path & "￥数据表"

14. .Open

15. End With

16. Set rs = New ADODB.Recordset

17. Sql = "select * from [Sheet1$]"

18. rs.Open Sql, Cnn, adOpenKeyset, adLockOptimistic

19. For j = 0 To rs.Fields.Count - 1

20. .Cells(1, j + 1) = rs.Fields(j).Name

21. Next

22. R = .Range("A65536").End(xlUp).Row

23. .Range("A" & R + 1).CopyFromRecordset rs

24. End With

25. rs.Close

26. Cnn.Close

27. Set rs = Nothing

28. Set Cnn = Nothing
29.EndSub；代码解析：；CopyData_5过程使建立与“数据表”工作簿；第8行代码删除当前工作表的所有数据；第9行到第15行代码建立与“数据表”工作簿的连接；第16行到第24行代码查询“数据表”工作簿的全部；其它收集的相关内容：（返回目录）；示例代码1：SubtestGetValuesFr；GetValuesFromAClosedWork；EndS

29. End Sub

代码解析：

CopyData_5过程使建立与“数据表”工作簿的连接，查询数据记录后复制到当前工作表中。

第8行代码删除当前工作表的所有数据。

第9行到第15行代码建立与“数据表”工作簿的连接。

第16行到第24行代码查询“数据表”工作簿的全部数据，并复制到工作表中。其中第20行代码将字段名称（标题行）复制到工作表中，第23行代码将查询到的数据记录复制到工作表。

其它收集的相关内容：（返回目录）

示例代码1： Sub testGetValuesFromClosedWorkbook()

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 = "='" & fPath & "\[" & fName & "]" _

& sName & "'!" & cellRange

.Value = .Value

End With

End Sub

本示例包含一个子过程GetValuesFromAClosedWorkbook，用来从已关闭的工作簿中获取数据，主过程testGetValuesFromClosedWorkbook用来传递参数。本示例表示从C盘根目录下的Book1.xls

工作簿的工作表Sheet1中的A1:G20单元格区域内获取数据，并将其复制到当前工作表相应单元格区域中。

示例代码2：

已前面的代码相似，下面的VBA代码从关闭的工作簿中获取值。

Sub ExtractDataFromClosedWorkBook()

Application.ScreenUpdating = False

'创建链接来从关闭的工作簿中获取数据

'可以将相关代码修改为相应的路径和单元格

With [Sheet1!A1:B4]

.Value = "='" & ActiveWorkbook.Path & "\[testDataWorkbook.xls]Sheet1'!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:\文件夹名\文件.xls", True, True)

With ThisWorkbook.Worksheets("工作表名")

'从工作簿中读取数据

.Range("A10").Formula = wb.Worksheets("源工作表名").Range("A10").Formula

.Range("A11").Formula = wb.Worksheets("源工作表名").Range("A20").Formula

.Range("A12").Formula = wb.Worksheets("源工作表名").Range("A30").Formula

.Range("A13").Formula = wb.Worksheets("源工作表名").Range("A40").Formula

End With

wb.Close False '关闭打开的源数据工作簿且不保存任何变化

Set wb = Nothing '释放内存

Application.ScreenUpdating = True

End Sub

在运行程序时，打开所要获取数据的工作簿，当取得数据后再关闭该工作簿。将屏幕更新属性值设置为False，将看不出源数据工作簿是否被打开过。本程序代码中，“C:\文件夹名\文件.xls”、”源工作表名”代表工作簿所在的文件夹和工作簿文件名。

示例代码4：

下面是JOHN WALKENBACH先生使用VBA编写的一个实用函数，其作用是从关闭的工作簿中取值。

VBA没有包含从关闭的文件中获取值的方法，但是利用Excel处理连接文件的功能，可以实现。该函数要调用XLM宏，

但不能在工作表公式中使用该函数。

GetValue函数

具有四个参数，分别如下：

?

?

?

? path: 关闭的文件的驱动器和路径(例如”d:￥files”) 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) = "" Then

GetValue = "File Not Found"

Exit Function

End If

' 创建参数

arg = "'" & path & "[" & file & "]" & sheet & "'!" & _

Range(ref).Range("A1").Address(, , xlR1C1)

' 执行XLM宏

GetValue = ExecuteExcel4Macro(arg)

End Function

使用GetValue函数

要

使用该函数，将其复制到VBA模块中，然后使用合适的参数调用该函数。

子过程演示如下，简单地显示在名为99Budget.xls工作簿Sheet1的单元格A1中的值，该文件在驱动器C:中的XLFiles\Budget目录下。

Sub TestGetValue()

p = "c:\XLFiles\Budget"

f = "99Budget.xls"

s = "Sheet1″"

a = "A1″"

MsgBox GetValue(p, f, s, a)

End Sub

另一个示例如下，该过程从一个关闭的文件中读取1,200个值(100行和12列)，并将这些值放置到活动工作表中。

Sub TestGetValue2()

p = "c:\XLFiles\Budget"

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

Application.ScreenUpdating = True

End 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:\文件夹名"

'创建文件夹中工作簿列表

wbCount = 0

wbName = Dir(FolderName & "\" & "*.xls")

While wbName <> ""

wbCount = wbCount + 1

ReDim Preserve wbList(1 To wbCount)

wbList(wbCount) = wbName

wbName = Dir

Wend

If wbCount = 0 Then Exit Sub

'从每个工作簿中获取数据

r = 0

Workbooks.Add

For i = 1 To wbCount

r = r + 1

cValue = GetInfoFromClosedFile(FolderName, wbList(i), "Sheet1", "A1")

Cells(r, 1).Formula = wbList(i)

Cells(r, 2).Formula = cValue

Next i

End Sub

Private Function GetInfoFromClosedFile(ByVal wbPath As String, _

wbName As String, wsName As String, cellRef As String) As Variant

Dim arg As String

GetInfoFromClosedFile = ""

If Right(wbPath, 1) <> "\" Then wbPath = wbPath & "\"

If Dir(wbPath & "\" & wbName) = "" Then Exit Function

arg = "'" & wbPath & "[" & wbName & "]" & _

wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1)

On Error Resume Next

GetInfoFromClosedFile = ExecuteExcel4Macro(arg)

End Function

本示例将读取一个文件夹内所有工作簿中工作表Sheet1单元格A1的值到一个新工作簿中。代码中，“C:\文件夹名”代表工作簿所在的文件夹名。